CODEWITHSUNDEEP
excelvba
Laura Kane-Punyon
Laura Kane-Punyon

Reputation: 201

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

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

Upvotes: 10

Views: 91316

Answers (4)

iDevlop
iDevlop

Reputation: 25272

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

Upvotes: 8

brettdj
brettdj

Reputation: 55702

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

Upvotes: 11

Jon49
Jon49

Reputation: 4606

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

Upvotes: 0

Metaller
Metaller

Reputation: 514

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

Upvotes: 1

Related Questions