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

Question

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

That's a challenging problem. It looks like AutoFilter only supports two up to two criteria. Have you tried recording a macro of all values deselecting those three? — Brian Nickel
– Brian Nickel, Commented Jan 9, 2015 at 20:49
The two Criteria limit is a bit of a bummer, but you can get around it by passing in an Array. This seems like a similar situation which might be helpful: stackoverflow.com/questions/18868332/… — Dan Wagner
– Dan Wagner, Commented Jan 9, 2015 at 20:54
@DanWagner Ah, that's what I was wondering about. If we have a known set of possible values for the field (because it's enforced by a rule) then we can filter on the specific set of items we want to delete. If it's freeform and we have to search inside, then an iterative approach is probably best. — Brian Nickel
– Brian Nickel, Commented Jan 9, 2015 at 21:03
A workaround is to make an IF test in a working column that runs all the criteria you need, then delete the TRUE (or FALSE) outcomes, see below. — brettdj
– brettdj, Commented Jan 10, 2015 at 14:25

Jason Faulkner · Accepted Answer · 2015-01-09 20:48:54Z

2

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.

answered Jan 9, 2015 at 20:48

Jason Faulkner

6,6682 gold badges31 silver badges33 bronze badges

Sign up to request clarification or add additional context in comments.

2 Comments

MadChadders Over a year ago

Dumb question, but would there be an easy way to do the reverse with this same coding? If you wanted to only delete items that contain those values? would you just change the '= 0 _' to '<> 0 _'?

Jason Faulkner Over a year ago

@MadChadders - Yes, you could apply the same idea. Just change the = to <> and change And to Or.

user4386917 · Accepted Answer · 2015-01-10 03:27:42Z

2

'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

answered Jan 10, 2015 at 3:27

user4386917

Comments

user4386917 · Accepted Answer · 2015-01-10 03:37:29Z

1

'
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

answered Jan 10, 2015 at 3:37

user4386917

Comments

brettdj · Accepted Answer · 2015-01-10 14:24:09Z

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

Collectives™ on Stack Overflow

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

4 Answers 4

2 Comments

Comments

Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

4 Answers 4

2 Comments

Comments

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related