Fastest way to (auto)filter multiple criterias in Excel and delete non-matching rows?

Question

I have the following code that I am using as a workaround instead of filtering the data as I have multiple criterias. I read somewhere that it is only possible to filter 2 criterias at a time?
The thing is that I have 5 - AB, DZ, RE, Z3, ZP - everything else should be deleted. So I am using the code below, which works fine, but having to deal with +30000 rows everytime I run the macro, it is extremely slow.
Is there anyway you can do this faster? I was thinking of just filtering each criteria at a time (creating 5 of the first of the below codes). But if there is anyway to do it faster, I would appreciate some help.

THE CODE I USE THAT IS SLOW:

' Step 13 - Filter and Delete All Except
'           AB, DZ, RE, Z3, ZP in Column 6 - Type
Sub FilterDeleteType()
Dim rTable As Range, r As Range
Dim rDelete As Range
Set rDelete = Nothing
Dim v As Variant

Worksheets("Overdue Items").Activate

For Each r In Columns(6).Cells
    v = r.Value
    If v <> "Type" And v <> "AB" And v <> "DZ" And v <> "RE" And v <> "Z3" And v <> "ZP" Then
        If rDelete Is Nothing Then
            Set rDelete = r
        Else
            Set rDelete = Union(r, rDelete)
        End If
    End If
Next

If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
End Sub

Do the usual and include: `Application.EnableEvents = False` and `Application.ScreenUpdating = False` and `Application.Calculation = xlCalculationManual` at the beginning of the code and revert back at the end. — Ralph, Aug 07 '15 at 08:21
Thank you @Ralph however, I do not see any difference in the speed :-( — Niclas, Aug 07 '15 at 09:14
You might be interested in this answer ["VBA Performance - Delete one million rows in less than 1 min"](http://stackoverflow.com/questions/30959315/excel-vba-performance-1-million-rows-delete-rows-containing-a-value-in-less) — paul bica, Aug 07 '15 at 11:47

score 1 · Answer 1 · answered Aug 07 '15 at 11:46

1

You can just look in hidden rows and check that column -

Sub test()

Dim lastrow As Integer
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Dim lastcol As Integer
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column

'do your autofilter here

For i = 1 To lastrow
    If Rows(i).Hidden = True Then
        Range(Cells(i, 1), Cells(i, 5)).ClearContents
        Range(Cells(i, 7), Cells(i, lastcol)).ClearContents
        If Cells(i, 6) <> "AB" Or "DZ" Or "RE" Or "Z3" Or "ZP" Then
            Cells(i, 6).ClearContents
        End If
    End If
Next
End Sub

answered Aug 07 '15 at 11:46

Raystafarian

2,902
2
29
42

Hi @raystafarian I apologize for my late reply, I have been on vacation. But it is not working. I would have to filter manually to get this to work, which I am not interested in. Secondly, I am getting a run-time error when running it. – Niclas Aug 17 '15 at 08:56
You can put your filter in where the comment "do your autofilter" is - this should fix the error and you won't need to manually filter – Raystafarian Aug 17 '15 at 09:01
Hi again, you answer was somewhat useful, but I ended going another way. I upvoted it for guiding me in the right direction tho :) thanks. – Niclas Aug 17 '15 at 10:42

score 0 · Accepted Answer · edited May 23 '17 at 11:58

So I managed to do exactly what my previous code was doing, just significantly faster. With the help from this post https://stackoverflow.com/a/22275522
What the code is doing is that it filter the values that I want (using an array), and then it will delete the hidden rows, meaning the rows that has NOT been filtered.

Sub FilterType()
Dim LRow As Long
Dim delRange As Range
Dim oRow As Range, rng As Range
Dim myRows As Range

Const Opt1 As String = "AB"
Const Opt2 As String = "DZ"
Const Opt3 As String = "RE"
Const Opt4 As String = "Z3"
Const Opt5 As String = "ZP"

On Error GoTo ErrHandler:
Sheets(1).Activate
With ThisWorkbook.Sheets(1)
    '~~> Remove any filters
    .AutoFilterMode = False

    LRow = .Range("F" & .Rows.Count).End(xlUp).Row

    With .Range("F1:F" & LRow)
        .AutoFilter Field:=1, Criteria1:=Array(Opt1, Opt2, Opt3, Opt4, Opt5), Operator:=xlFilterValues
    End With

    With Sheets(1)
        Set myRows = Intersect(.Range("F:F").EntireRow, .UsedRange)
        If myRows Is Nothing Then Exit Sub
    End With

    For Each oRow In myRows.Columns(6).Cells
    If oRow.EntireRow.Hidden Then
        If rng Is Nothing Then
            Set rng = oRow
        Else
            Set rng = Union(rng, oRow)
        End If
    End If
    Next

ErrHandler:
    '~~> Remove any filters
    .AutoFilterMode = False
End With
If Not rng Is Nothing Then rng.EntireRow.Delete
End Sub

Fastest way to (auto)filter multiple criterias in Excel and delete non-matching rows?

2 Answers2