Most Effective Multi-Column Delete Row Filter [VBA]

[DataBlake]

what would be the most effective way i could filter every column for the same criteria? so far i can think of the below sub i made, but it doesnt seem to be that efficient if multiple columns contain the criteria. If you could help me to understand another method i would greatly appreciate the help.

Sub test()
    Dim p As Long
    Dim lastCol As Long
    
    lastCol = Range("A1").SpecialCells(xlCellTypeLastCell).Column
    
    For p = 1 To lastCol
        With ActiveSheet.Range("A1")
            
            .AutoFilter Field:=p, Criteria1:="=*Trailer*", Criteria2:="=*Dually*", Operator:=xlOr
            On Error GoTo 0
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            
            AutoFilterMode = False
        End With
        Next p
        
    End Sub

 

[Fluff]

That's pretty much how I'd do it.

 

[Peter_SSs]

what would be the most effective way ...

Depends a bit on how big (rows & columns) your data might be and what you mean by effective (eg short code, fast code, ease of understanding code, ..)

For data that isn't huge, here is another way that doesn't require the looping through each column.

Sub Test2()
  Dim rCrit As Range
  
  Application.ScreenUpdating = False
  With ActiveSheet.UsedRange
    Set rCrit = .Offset(.Rows.Count + 2).Resize(2, 1)
    rCrit.Cells(2).Formula = Replace("=COUNTIF(#,""*Dually*"")+COUNTIF(#,""*Trailer*"")", "#", .Rows(2).Address(0, 0))
    .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCrit, Unique:=False
    .Offset(1).EntireRow.Delete
    .Parent.ShowAllData
    rCrit.ClearContents
  End With
  Application.ScreenUpdating = True
End Sub

 

[DataBlake]

Depends a bit on how big (rows & columns) your data might be

my data can get up to 10,000+ rows and sometimes contain over 1,000 items in the filter.
i run this twice one with the above and one with
"duallie" and "trailor"
it just seems to take a long time to accomplish the task i guess.
yours did seem to be a little faster still, but nothing game changing.
thanks for the replies.

 

[Peter_SSs]

... sometimes contain over 1,000 items in the filter.

Not exactly sure what you mean by this, but give this version a try.

Sub Del_Rows()
  Dim a, b
  Dim nc As Long, i As Long, j As Long, k As Long, uba2 As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("A1").CurrentRegion.Value
  uba2 = UBound(a, 2)
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    For j = 1 To uba2
      If InStr(1, a(i, j), "trailer", 1) > 0 Then
        b(i, 1) = 1
        k = k + 1
        Exit For
      ElseIf InStr(1, a(i, j), "dually", 1) > 0 Then
        b(i, 1) = 1
        k = k + 1
        Exit For
      End If
    Next j
  Next i
  If k > 0 Then
    Application.ScreenUpdating = False
    With Range("A1").Resize(UBound(a), nc)
      .Columns(nc).Value = b
      .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo, _
            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
      .Resize(k).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  End If
  MsgBox "Done"
End Sub

 

[DataBlake]

Not exactly sure what you mean by this, but give this version a try.

i mean there is usually 1000 or more rows with "trailer" or dually" rows that need filtered

also when i run the macro i get Run-time error '13': type mismatch
on this line

If InStr(1, a(i, j), "trailer", 1) > 0 Then

when i hover over a:

a(i, j) = error 2042

when i hover over InStr:

If InStr(1, a(i, j), "trailer", 1 = <type mismatch=""><type mismatch=""><type mistmatch="">< type mismatch >

in debugger:
i = 15
j = 35</type></type></type>

 

[Peter_SSs]

Sounds like you have error(s) in your data. Have a look at cell AI15 [i=15 means row 15, j=35 means column 35 (AI)].
Can you eliminate the errors earlier in the process? Otherwise we can modify the macro.

 

[DataBlake]

Sounds like you have error(s) in your data

what would errors constitute as? any error text? I can replace #N/A with blanks if that works, but yeah it picked up a #N/A

 

[DataBlake]

after replacing #N/A with a blank cell that worked surprisingly fast.
and if i understand the macro correctly i can copy down "elseif" to "exit for" to create new criterias?

 

[Peter_SSs]

after replacing #N/A with a blank cell that worked surprisingly fast.

Good news. If you don't want to have to eliminate the errors before running the code, the code could be modified to ignore the error values. Just add these 2 blue lines where shown.

For i = 1 To UBound(a)
  For j = 1 To uba2
    If Not IsError(a(i, j)) Then
      If InStr(1, a(i, j), "trailer", 1) > 0 Then
        b(i, 1) = 1
        k = k + 1
        Exit For
      ElseIf InStr(1, a(i, j), "dually", 1) > 0 Then
        b(i, 1) = 1
        k = k + 1
        Exit For
      End If
    End If
  Next j
Next i

Having said that, I think it best to eliminate error values whenever possible.

... and if i understand the macro correctly i can copy down "elseif" to "exit for" to create new criterias?

You could, but it may not be the best way. For example, if you 500 criteria it would make for a very long code.
So about how many criteria might you have?