How can I use VBA in Excel to delete rows containing one of several text strings?-CodePudding

I have very little knowledge/experience using VBA in Excel and I'm trying to find a way to delete entire rows if any of the cells in that row contain one of several text strings. After a google search or two I found this page:

https://excel.officetuts.net/vba/delete-a-row-if-cell-contains/

which suggested using the following code:

Sub DeleteRows()
Dim rng As Range
Dim pos As Integer
Set rng = ActiveSheet.UsedRange

For i = rng.Cells.Count To 1 Step -1
    pos = InStr(LCase(rng.Item(i).Value), LCase("delete"))
    If pos > 0 Then
        rng.Item(i).EntireRow.Delete
    End If
Next i
End Sub

The example above would delete any rows containing the text "delete" and is case insensitive.

What I would like to achieve is something similar, but with the ability to use more than one text string so that all rows containing the words "delete" or "banana" or "hospital" would be deleted for example. Is there a way to amend this sample code to achieve my goal, or would a different approach entirely be required?

Thanks in advance for your help.

CodePudding user response：

Sub DeleteRows()
Dim rng As Range
Set rng = ActiveSheet.UsedRange

For i = rng.Cells.Count To 1 Step -1
    If InStr(LCase(rng.Item(i).Value), LCase("delete")) <> 0 _
       Or InStr(LCase(rng.Item(i).Value), LCase("banana")) <> 0 _
       Or InStr(LCase(rng.Item(i).Value), LCase("hospital")) <> 0 _
    Then
        rng.Item(i).EntireRow.Delete
    End If
Next i
End Sub

You can use the keywords OR and AND to add boolean expressions together. Instr returns a number when the substring is found, and 0 when not found. So we just need to confirm that instr returns "not 0". So if one of those returns "not 0" then the expression is TRUE.

CodePudding user response：

Delete Multi-Criteria Rows

Option Explicit

Sub DeleteCriticalRows()
    
    Dim Criteria As Variant: Criteria = Array("delete", "banana", "hospital")
    
    Dim rng As Range: Set rng = ActiveSheet.UsedRange ' Used Range
    
    Dim rrg As Range ' Current Row Range
    Dim rCell As Range ' Current Cell in Current Row Range
    Dim r As Long ' Current Row
    
    ' Loop through the rows of the range from the bottom to the top.
    For r = rng.Rows.Count To 1 Step -1 ' 'To 2' if headers
        Set rrg = rng.Rows(r)
        ' Loop through each cell of the current row range (from left to right).
        For Each rCell In rrg.Cells
            If IsNumeric(Application.Match(CStr(rCell.Value), Criteria, 0)) Then
                rrg.Delete
                Exit For ' no need to loop cells in this row any more
            End If
        Next rCell
    Next r

    MsgBox "Critical rows deleted.", vbInformation

End Sub