How to delete rows in Excel based on criteria using VBA? - excel

Question

I am currently building a macro to format a sheet of data as well as to remove inapplicable rows of data. Specifically, I am looking to delete rows where Column L = "ABC" as well as delete rows where Column AA <> "DEF".
So far I have been able to achieve the first objective, but not the second. The existing code is:
Dim LastRow As Integer
Dim x, y, z As Integer
Dim StartRow, StopRow As Integer
For x = 0 To LastRow
If (Range("L1").Offset(x, 0) = "ABC") Then
Range("L1").Offset(x, 0).EntireRow.Delete
x = x - 1
End If

Answer 1

It is normally much quicker to use AutoFilter rather than loop Ranges
The code below creates a working column, then use a formula to detect delete criteria and then autofilter and delete the result records
The working column puts a formula
=OR(L1="ABC",AA1<>"DEF")
into row 1 of the first blank column then copies down as far ar the true used range. Then any TRUE records are quicklly deleted with AutoFilter
Sub QuickKill()
Dim rng1 As Range, rng2 As Range, rng3 As Range
Set rng1 = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious)
Set rng2 = Cells.Find("*", , xlValues, , xlByRows, xlPrevious)
Set rng3 = Range(Cells(rng2.Row, rng1.Column), Cells(1, rng1.Column))
Application.ScreenUpdating = False
Rows(1).Insert
With rng3.Offset(-1, 1).Resize(rng3.Rows.Count + 1, 1)
.FormulaR1C1 = "=OR(RC12=""ABC"",RC27<>""DEF"")"
.AutoFilter Field:=1, Criteria1:="TRUE"
.EntireRow.Delete
On Error Resume Next
'in case all rows have been deleted
.EntireColumn.Delete
On Error GoTo 0
End With
Application.ScreenUpdating = True
End Sub

Answer 2

Using a loop:
Sub test()
Dim x As Long, lastrow As Long
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For x = lastrow To 1 Step -1
If Cells(x, 12).Value = "ABC" or Cells(x, 27) <> "DEF" Then
Rows(x).Delete
End If
Next x
End Sub
Using autofilter (probably faster):
Sub test2()
Range("a1").AutoFilter Field:=12, Criteria1:="ABC", Operator:=xlOr, _
Field:=28, Criteria1:="<>""DEF"""
'exclude 1st row (titles)
With Intersect(Range("a1").CurrentRegion, _
Range("2:60000")).SpecialCells(xlCellTypeVisible)
.Rows.Delete
End With
ActiveSheet.ShowAllData
End Sub

Answer 3

Cell with number 12 is "L" and number 27 is "AA"
Dim x As Integer
x = 1
Do While x <= ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
If (Cells(x, 12) = "ABC") Then
ActiveSheet.Rows(x).Delete
Else
If (Cells(x, 27) <> "DEF") And (Cells(x, 27) <> "") Then
ActiveSheet.Rows(x).Delete
Else
x = x + 1
End If
End If
Loop
End Sub

Answer 4

Sub test()
Dim bUnion As Boolean
Dim i As Long, lastrow As Long
Dim r1 As Range
Dim v1 As Variant
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
v1 = ActiveSheet.Range(Cells(1, 12), Cells(lastrow, 27)).Value2
bUnion = False
For i = 1 To lastrow
If v1(i, 1) = "ABC" Or v1(i, 16) <> "DEF" Then
If bUnion Then
Set r1 = Union(r1, Cells(i, 1))
Else
Set r1 = Cells(i, 1)
bUnion = True
End If
End If
Next i
r1.EntireRow.Delete
End Sub