Deleting rows in excel using VBA depending on values found using a formula [duplicate] - excel

Question

This question already has answers here:
Delete Row based on Search Key VBA
(3 answers)
Closed 8 years ago.
Hey guys I am trying to write a code that deletes rows having values that are found using a formula. The problem is every other row is a #VALUE!, which I cannot change due to the setup of the report. In the end I want to delete all rows that have #VALUE! and any row that has values that are less than .75 in Column H.
The code I tried is as shown below:
Private Sub CommandButton1_Click()
Dim rng As Range, cell As Range, del As Range
Set rng = Intersect(Range("H1:H2000"), ActiveSheet.UsedRange)
For Each cell In rng
If (cell.Value) < .75 Then
If del Is Nothing Then
Set del = cell
Else: Set del = Union(del, cell)
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete
End Sub
Any help or tips would be appreciated.

Answer 1

I suggest stepping backwards through the rows so that when a row is deleted you don't lose your place.
Assuming that you want to look at cells contained in column H you could do something like this:
Sub Example()
Const H As Integer = 8
Dim row As Long
For row = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
On Error Resume Next
If Cells(row, H).Value < 0.75 Then
Rows(row).Delete
End If
On Error GoTo 0
Next
End Sub

Answer 2

my code is an alternative to the other answers, its much more efficient and executes faster then deleting each row separately :) give it a go
Option Explicit
Sub DeleteEmptyRows()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim i&, lr&, rowsToDelete$, lookFor$, lookFor2$
'*!!!* set the condition for row deletion
lookFor = "#VALUE!"
lookFor2 = "0.75"
Set ws = ThisWorkbook.Sheets("Sheet1")
lr = ws.Range("H" & Rows.Count).End(xlUp).Row
ReDim arr(0)
For i = 1 To lr
If StrComp(CStr(ws.Range("H" & i).Text), lookFor, vbTextCompare) = 0 Or _
CDbl(ws.Range("H" & i).Value) < CDbl(lookFor2) Then
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr) - 1) = i
End If
Next i
If UBound(arr) > 0 Then
ReDim Preserve arr(UBound(arr) - 1)
For i = LBound(arr) To UBound(arr)
rowsToDelete = rowsToDelete & arr(i) & ":" & arr(i) & ","
Next i
ws.Range(Left(rowsToDelete, Len(rowsToDelete) - 1)).Delete Shift:=xlUp
Else
Application.ScreenUpdating = True
MsgBox "No more rows contain: " & lookFor & "or" & lookFor2 & ", therefore exiting"
Exit Sub
End If
If Not Application.ScreenUpdating Then Application.ScreenUpdating = True
Set ws = Nothing
End Sub

Answer 3

Try:
Private Sub CommandButton1_Click()
Dim rng As Range, cell As Range, del As Range, v As Variant
Set rng = Intersect(Range("H1:H2000"), ActiveSheet.UsedRange)
For Each cell In rng
v = cell.Text
If v < 0.75 Or v = "#VALUE!" Then
If del Is Nothing Then
Set del = cell
Else: Set del = Union(del, cell)
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete
End Sub