Filter in Excel VBA

Question

I have a loop in VBA that loops through about 3000+ records and hides the ones that don't fit the criteria. It works just fine but it runs SUPER slow. Is there a faster or more efficient way to filter based on the following criteria? Any help would be greatly appreciated.

Dim i As Long, rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5 As Range, j As Long, sheetName As String, rng6 As Range, rng7 As Range, rng8 As Range, rng9 As Range

Set rng1 = FindHeader("Client Exclusion List", Sheet8.Name)
Set rng2 = FindHeader("CLIENT NAME", Sheet5.Name)
Set rng3 = FindHeader("MARKET SEGMENT", Sheet5.Name)
Set rng4 = FindHeader("ARCHIVED", Sheet5.Name)
Set rng5 = FindHeader("FORMULARY NAME", Sheet5.Name)
Set rng6 = FindHeader("WEBSITE", Sheet5.Name)
Set rng7 = FindHeader("PDF", Sheet5.Name)
Set rng8 = FindHeader("HPMS EXPORTED", Sheet5.Name)
Set rng9 = FindHeader("SERFF EXPORTED", Sheet5.Name)

For i = 1 To rng2.Rows.Count
'Checks to see if the Client Name is in the Excluded list
    For j = 1 To rng1.Rows.Count

        If rng2.Cells(i, 1).Value = rng1.Cells(j, 1).Value Then
            rng2.Cells(i, 1).EntireRow.Hidden = True
        End If

    Next j

    'Checks For all CMS records and hides the ones that are not from current year

    If Left(rng3.Cells(i, 1).Value, 8) = "CMS Part" Then
        If rng3.Cells(i, 1).Value <> "CMS Part D (CY " & Year(Date) & ")" Then
            rng3.Cells(i, 1).EntireRow.Hidden = True
        End If
    End If
    'Checks if record is archived
    If rng4.Cells(i, 1).Value = "Yes" Then
        rng4.Cells(i, 1).EntireRow.Hidden = True
    End If
'Checks if record contains "Test" or "Demo" in the Name
    If InStr(1, CStr(rng5.Cells(i, 1).Value), "test") > 0 Or InStr(1, CStr(rng5.Cells(i, 1).Value), "Test") > 0 Or InStr(1, CStr(rng5.Cells(i, 1).Value), "demo") > 0 Or InStr(1, CStr(rng5.Cells(i, 1).Value), "Demo") > 0 Or InStr(1, CStr(rng5.Cells(i, 1).Value), "TEST") > 0 Or InStr(1, CStr(rng5.Cells(i, 1).Value), "DO NOT USE") > 0 Then
        rng5.Cells(i, 1).EntireRow.Hidden = True
    End If

Next i

Answer 1

One small change that should help is adding

Application.ScreenUpdating = False 

at the beginning and

Application.ScreenUpdating = True

at the end

The screen updating time can be much more substantial than the logic.

Edit as an alternative to the array loop. Creates a dictionary filled with the excluded items as keys before the big loop. A set would be better here since you have a useless item to go with each key but I don't think VBA has those.

Instead of the loop through the range or an array you just check for the existence of the key in the dictionary.

   'before loop
    Dim excludedList As Object
    Set excludedList = CreateObject("Scripting.Dictionary")
    For i = 1 To rng1.Rows.Count
        excludedList.Add rng1.Cells(i, 1).value, 1
    Next i

    '****************************************
    'in loop
    If excludedList.exists(rng2.Cells(i, 1).Value) Then
        rng2.Cells(i, 1).EntireRow.Hidden = True
    End If

Answer 2

Here's an example that should be faster. It uses array, autofilter and doesn't process all the other ranges for each row of rng2:

Dim rng1                  As Range
Dim rng2                  As Range
Dim rng3                  As Range
Dim rng4                  As Range
Dim rng5                  As Range
Dim rng6                  As Range
Dim rng7                  As Range
Dim rng8                  As Range
Dim rng9                  As Range
Dim i                     As Long
Dim j                     As Long
Dim sheetName             As String
Dim vData1

Set rng1 = FindHeader("Client Exclusion List", Sheet8.Name)
Set rng2 = FindHeader("CLIENT NAME", Sheet5.Name)
Set rng3 = FindHeader("MARKET SEGMENT", Sheet5.Name)
Set rng4 = FindHeader("ARCHIVED", Sheet5.Name)
Set rng5 = FindHeader("FORMULARY NAME", Sheet5.Name)
Set rng6 = FindHeader("WEBSITE", Sheet5.Name)
Set rng7 = FindHeader("PDF", Sheet5.Name)
Set rng8 = FindHeader("HPMS EXPORTED", Sheet5.Name)
Set rng9 = FindHeader("SERFF EXPORTED", Sheet5.Name)

Application.ScreenUpdating = False

vData1 = rng1.Value

For i = 1 To rng2.Rows.Count
    'Checks to see if the Client Name is in the Excluded list
    For j = LBound(vdata1, 1) To UBound(vdata1, 1)

        If rng2.Cells(i, 1).Value = vdata1(j, 1) Then
            rng2.Cells(i, 1).EntireRow.Hidden = True
            Exit For
        End If

    Next j
Next i

'Checks For all CMS records and hides the ones that are not from current year

rng3.AutoFilter 1, "<>CMS Part*", xlOr, "CMS Part D (CY " & Year(Date) & ")"
'Checks if record is archived
rng4.AutoFilter 1, "<>Yes"
'Checks if record contains "Test" or "Demo" in the Name
rng5.AutoFilter 1, "<>*test*", xlAnd, "<>*demo*"

Application.ScreenUpdating = True