Most Effective Multi-Column Delete Row Filter [VBA]

DataBlake

Well-known Member
Joined
Jan 26, 2015
Messages
781
Office Version
  1. 2016
Platform
  1. Windows
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.

Code:
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
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
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.

Code:
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
 
Upvote 0
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.
 
Last edited:
Upvote 0
... sometimes contain over 1,000 items in the filter.
Not exactly sure what you mean by this, but give this version a try.

Code:
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
 
Last edited:
Upvote 0
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
Code:
If InStr(1, a(i, j), "trailer", 1) > 0 Then

when i hover over a:
Code:
a(i, j) = error 2042

when i hover over InStr:
Code:
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>
 
Last edited:
Upvote 0
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.
 
Upvote 0
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?
 
Upvote 0
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.
Rich (BB code):
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. :eek:
So about how many criteria might you have?
 
Upvote 0

Forum statistics

Threads
1,223,886
Messages
6,175,196
Members
452,616
Latest member
intern444

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top