CODEWITHSUNDEEP
vbaexcel
Matthew Bershok
Matthew Bershok

Reputation: 21

Excel VBA deleting entire row based on multiple conditions in a column

I am trying to write a macro in vba for excel. I want to delete every row that does not have at least one of three keywords in column D (keywords being "INVOICE", "PAYMENT", or "P.O."). I need to keep every row that contains these keywords. All other rows need to be deleted and the rows remaining need to be pushed to the top of the document. There are also two header rows that can not be deleted.

I found the code below but it deletes every row that does not contain "INVOICE" only. I can not manipulate the code to do what I need it to do.

Sub Test()

     Dim ws As Worksheet
     Dim rng1 As Range
     Dim lastRow As Long

     Set ws = ActiveWorkbook.Sheets("*Name of Worksheet")

     lastRow = ws.Range("D" & ws.Rows.Count).End(xlUp).Row

     Set rng = ws.Range("D1:D" & lastRow)

     ' filter and delete all but header row
     With rng
         .AutoFilter Field:=1, Criteria1:="<>*INVOICE*"
         .Offset(2, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
     End With

     ' turn off the filters
     ws.AutoFilterMode = False

 End Sub

Upvotes: 1

Views: 13093

Answers (4)

brettdj
brettdj

Reputation: 55682

The othe way is to insert an IF test in a working column, and then AutoFilter that.

This is the VBA equivalent of entering
=SUM(COUNTIF(D1,{"*INVOICE*","*PAYMENT*","*P.O.*"}))=0 and then deleting any row where none of these values are found in the corrresponing D cell

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 = "=SUM(COUNTIF(RC[-1],{""*INVOICE*"",""*PAYMENT*"",""*P.O.*""}))=0"
        .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: 0

user4386917
user4386917

Reputation: 

'
Sub test()
    Dim i&
    Application.ScreenUpdating = False
    i = Range("D" & Rows.Count).End(xlUp).Row
    While i <> 1
        With Cells(i, 4)
            If Not (.value Like "*INVOICE*" _
                Or .value Like "*PAYMENT*" _
                Or .value Like "*P.O.*") _
                Then
                Rows(i).Delete
            End If
        End With
        i = i - 1
    Wend
    Application.ScreenUpdating = True
 End Sub

Upvotes: 1

user4386917
user4386917

Reputation: 

'similar with previous post, but using "like" operator

 Sub test()
    Dim ws As Worksheet, i&, lastRow&, value$
    Set ws = ActiveWorkbook.ActiveSheet
    lastRow = ws.Range("D" & ws.Rows.Count).End(xlUp).Row
    For i = lastRow To 2 Step -1
        value = ws.Cells(i, 4).value
        ' Check if it contains one of the keywords.
        If Not (value Like "*INVOICE*" _
            Or value Like "*PAYMENT*" _
            Or value Like "*P.O.*") _
            Then
            ' Protected values not found. Delete the row.
            ws.Rows(i).Delete
        End If
    Next
 End Sub

Upvotes: 2

Jason Faulkner
Jason Faulkner

Reputation: 6558

I would approach this loop slightly different. To me this is a bit easier to read.

Sub Test()

    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim value As String

    Set ws = ActiveWorkbook.Sheets("*Name of Worksheet")
    lastRow = ws.Range("D" & ws.Rows.Count).End(xlUp).Row

    ' Evaluate each row for deletion.
    ' Go in reverse order so indexes don't get messed up.
    For i = lastRow To 2 Step -1
        value = ws.Cells(i, 4).Value ' Column D value.

        ' Check if it contains one of the keywords.
        If Instr(value, "INVOICE") = 0 _
            And Instr(value, "PAYMENT") = 0 _
            And Instr(value, "P.O.") = 0 _
            Then

            ' Protected values not found. Delete the row.
            ws.Rows(i).Delete
        End If
    Next

 End Sub

The key here is the Instr function which checks for your protected keywords within the cell value. If none of the keywords are found then the If condition is satisfied and the row is deleted.

You can easily add additional protected keywords by just appending to the If conditions.

Upvotes: 2

Related Questions