VBA code to delete row in an Excel table (ListObject) if a specific cell (DataBodyRange) includes a specific substring

Question

1. Summary. I am trying to loop through a table and delete each row if a particular substring is found in a specified column. I am specifically stuck on the line of code that finds the target text, which I know to be incorrect, but cannot find the proper syntax for what I'm trying to achieve: If tbl.DataBodyRange(rw, 10).Find(myString)

2. I have searched many websites and YouTube videos, and there are a few that address finding an exact value, but nothing I could find like the problem I'm trying to solve.

3. My code:

Sub removeTax()
Dim tbl As ListObject
Set tbl = ThisWorkbook.Sheets("Master").ListObjects("tblMaster")
Dim myString As String
myString = "Tax"

Dim rw

For rw = tbl.DataBodyRange.Rows.Count To 1 Step -1
    If tbl.DataBodyRange(rw, 10).Find(myString) Then
        tbl.ListRows.Delete
    End If    
Next

End Sub

Thank you very much for any assistance you can offer.

Answer 1

Delete Criteria Rows of an Excel Table (ListObject)

• As an alternative, this uses a method that uses AutoFilter and SpecialCells.

Usage

Sub RemoveTax()
    
    Const CritColumn As Long = 10
    Const CritString As String = "*Tax*" ' contains
    
    Dim tbl As ListObject
    Set tbl = ThisWorkbook.Worksheets("Master").ListObjects("tblMaster")
    
    DeleteTableCriteriaRows tbl, CritColumn, CritString

End Sub

The Method

Sub DeleteTableCriteriaRows( _
        ByVal Table As ListObject, _
        ByVal CriteriaColumn As String, _
        ByVal CriteriaString As String)

    With Table
        
        If .ShowAutoFilter Then
            If .AutoFilter.FilterMode Then .AutoFilter.ShowAllData
        Else
            .ShowAutoFilter = True
        End If
        
        .Range.AutoFilter CriteriaColumn, CriteriaString
        
        Dim rg As Range
        On Error Resume Next
            Set rg = .DataBodyRange.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        
        .AutoFilter.ShowAllData
        
        If Not rg Is Nothing Then rg.Delete xlShiftUp
    
    End With

End Sub

Answer 2

I've corrected your approach, it checks if myString is sub-string of values in column 10

With tbl.DataBodyRange.Columns(10)
    For rw = .Rows.Count To 1 Step -1
        If InStr(1, .Cells(rw).Value2, myString) > 0 Then
            tbl.ListRows(rw).Delete
        End If
    Next rw
End With

Keep in mind, you should check if tbl.DataBodyRange is not Nothing, before doing anything with it, since deleting all rows of a table makes DataBodyRange be equal to Nothing

I've decided to make a bit more efficient solution, more to my liking

Sub RemoveTaxQuicker()
    Const myString = "Tax"
    
    Dim tbl As ListObject
    Set tbl = ThisWorkbook.Sheets("Master").ListObjects("tblMaster")
    If tbl.DataBodyRange Is Nothing Then: Exit Sub
    
    Dim rowsRangeString As String
    Dim i As Long
    Dim C10 As Variant
    
    C10 = tbl.DataBodyRange.Columns(10).Value2
    Dim rng As Range
    
    If IsArray(C10) Then
        Set rng = Nothing
        For i = LBound(C10) To UBound(C10)
            If InStr(1, C10(i, 1), myString) > 0 Then
                If rng Is Nothing Then
                    Set rng = tbl.DataBodyRange.Cells(i, 1)
                Else
                    Set rng = Union(rng, tbl.DataBodyRange.Cells(i, 1))
                End If
            End If
        Next i
        If Not rng Is Nothing Then
            rng.Delete xlUp
        End If
    ElseIf InStr(1, C10, myString) > 0 Then
        tbl.ListRows(1).Delete
    End If
End Sub

This is no longer true :) You should use @VBasic2008 approach, I've tested it on 500k rows and it takes around 10 sec or so. And I had to test mine as well (was painfully long), it took ~5 mins. :)

Okay VBasic2008's solution forced me to think about this in a different way. The following solution executes almost instantly.

'works with formulas as well with some exceptions, thanks VBasic for pointing that as a potential problem
Sub RemoveTaxQuicker2()
    Const myString = "Tax"
    Const COLUMN = 10
    
    Dim tbl As ListObject
    Set tbl = ThisWorkbook.Sheets("Master").ListObjects("tblMaster")
    If tbl.DataBodyRange Is Nothing Then: Exit Sub
    
    Dim i As Long, j As Long
    Dim count As Long
    Dim sDataBody As Variant
    Dim sFormulas As Variant
    
    sDataBody = tbl.DataBodyRange.Formula
    sFormulas = tbl.ListRows(1).Range.Formula
    
    If tbl.DataBodyRange.Rows.count > 1 Then
        For i = LBound(sDataBody, 1) To UBound(sDataBody, 1)
            If InStr(1, sDataBody(i, COLUMN), myString) < 1 Then
                count = count + 1
                For j = LBound(sDataBody, 2) To UBound(sDataBody, 2)
                    sDataBody(count, j) = sDataBody(i, j)
                Next j
            End If
        Next i
    
        If count > 0 Then
            For i = LBound(sFormulas, 2) To UBound(sFormulas, 2)
                If Left$(sFormulas(1, i), 1) = "=" Then
                    sDataBody(1, i) = sFormulas(1, i)
                End If
            Next i
            tbl.DataBodyRange.Formula = sDataBody
            If tbl.ListRows.count > count Then
                tbl.ListRows(count + 1).Range.Resize(tbl.ListRows.count).ClearContents
                tbl.Resize tbl.Range.Resize(count + 1)
            End If
        End If
    ElseIf InStr(1, sDataBody(1, COLUMN), myString) > 0 Then
        On Error Resume Next
        tbl.DataBodyRange.SpecialCells(xlCellTypeConstants).ClearContents
        On Error GoTo 0
    End If
End Sub

Final note: I still prefer VBasic's method, if nothing else it's much cleaner and it works when the table is full of formulas that are not auto-filled :)