Sub slows down when called multiple times

Question

I am trying to filter data on 3 different sheets using this code, but the filterBy sub runs dramatically slower on the second and third sheet when I use expressPrepper to do it all in one click.

I'm guessing the second and third filter by run approximately 1/200 the speed of the first one. I can't figure out why.

All three sheets contain similar data, although the third is actually shorter (~6500 rows) than the first two (~16000 rows each).

Any help would be greatly appreciated!

Sub filterBy(filterlist As String, col As String, sht As String)
    Dim myArr As Variant
    myArr = buildArray(filterlist)
    clean myArr, col, sht

End Sub


Function buildArray(filterlist As String) As Variant

Dim myTable As ListObject
Dim TempArray As Variant

    Select Case filterlist

    Case Is = "I"
        Set myTable = Sheets("Competitive Set").ListObjects("Table1")
        TempArray = myTable.DataBodyRange.Columns(1)
        buildArray = Application.Transpose(TempArray)
    Case Is = "T"
        Set myTable = Sheets("Competitive Set").ListObjects("Table1")
        TempArray = myTable.DataBodyRange.Columns(2)
        buildArray = Application.Transpose(TempArray)
    Case Is = "IB"
        Set myTable = Sheets("Competitive Set").ListObjects("Table2")
        TempArray = myTable.DataBodyRange.Columns(1)
        buildArray = Application.Transpose(TempArray)
    Case Is = "TB"
        Set myTable = Sheets("Competitive Set").ListObjects("Table2")
        TempArray = myTable.DataBodyRange.Columns(2)
        buildArray = Application.Transpose(TempArray)
    Case Is = "AB"
        Set myTable = Sheets("Competitive Set").ListObjects("Table3")
        TempArray = myTable.DataBodyRange.Columns(1)
        buildArray = Application.Transpose(TempArray)
    End Select

End Function

Sub clean(arr As Variant, col As String, sht As String)

Dim IsInArray As Long
Dim product As String
Dim lastRow As Long, i As Long
Dim progress As Double


With Sheets(sht)
    lastRow = .Cells(Rows.Count, col).End(xlUp).Row
    For i = lastRow To 2 Step -1
          product = .Cells(i, col).Value
          IsInArray = UBound(filter(arr, product))
          If IsInArray < 0 Then
             .Rows(i).EntireRow.Delete
          End If

    progress = ((lastRow - i) / lastRow) * 100
    progress = Round(progress, 2)
    Debug.Print progress

    Next i

End With

End Sub

Sub expressPrepper()

filterBy "AB", "C", "Spend"
filterBy "AB", "C", "IMP"
filterBy "AB", "C", "GRP"

End Sub

`Clean` is a method of the *WorkSheetFunction* object. I'm not saying that this is the case here, but when you use reserved words in your own way you can't predict how VBA or Excel will deal with the challenge. Select "Clean" and press F1 for more information. — Variatus, Mar 01 '19 at 03:47
It would be faster to build up a range to delete using `Union` and then delete in one step, as opposed to deleting rows one by one. — BigBen, Mar 01 '19 at 03:54
I will find a new name for the `clean` sub. How would I go about building up a range using `Union`? — deskjet08, Mar 01 '19 at 04:46
Either use [Tags](https://stackoverflow.com/questions/36873359/fastest-way-to-delete-rows-which-cannot-be-grabbed-with-specialcells) as shown by Florent B. Or use [autofilter](https://stackoverflow.com/questions/11317172/delete-row-based-on-condition/11317372#11317372) or use [Union](https://stackoverflow.com/questions/20077945/delete-cells-in-an-excel-column-when-rows-0) — Siddharth Rout, Mar 01 '19 at 04:59

Variatus · Answer 1 · 2019-03-02T02:18:49.757

If I understand your program correctly there should be no need for filtering and, hence, no problem from applying thousands of filters. I have re-written your program - the way I understood it - without such need, basically, deleting rows which don't have a duplicate in the designated column. The code is untested.

Sub ExpressFilter()

    Dim Flt() As String, i As Integer
    Dim Sp() As String, j As Integer
    Dim TblName As String
    Dim ClmRng As Range

    Flt = Split("AB,C,Spend|AB,C,IMP|AB,C,GRP", "|")
    For i = 0 To UBound(Flt)
        Sp = Split(Flt(i), ",")
        Select Case Sp(0)
            Case Is = "I"
                TblName = "Table1"
                C = 1
            Case Is = "T"
                TblName = "Table1"
                C = 2
            Case Is = "IB"
                TblName = "Table2"
                C = 1
            Case Is = "TB"
                TblName = "Table2"
                C = 2
            Case Is = "AB"
                TblName = "Table3"
                C = 1
        End Select
        Set ClmRng = Worksheets("Competitive Set").ListObjects(TblName).DataBodyRange.Columns(C)

        DeleteSingles ClmRng, Columns(Sp(1)).Column, Sp(2)
    Next i
End Sub

Private Sub DeleteSingles(ClmRng As Range, _
                          C As Long, _
                          Sht As String)

    Dim Fnd As Range
    Dim IsInArray As Long
    Dim lastRow As Long, R As Long

    With Sheets(Sht)
        lastRow = .Cells(Rows.Count, C).End(xlUp).Row
        For R = lastRow To 2 Step -1
            With ClmRng
                Set Fnd = .Find(What:=.Cells(R, C).Value, _
                           After:=.Cells(.Cells.Count), _
                           LookIn:=xlValues, _
                           LookAt:=xlWhole, _
                           MatchCase:=False)
            End With
            If Fnd Is Nothing Then .Rows(R).EntireRow.Delete

            If (R Mod 25 = 0) or (R = 2) Then
                Application.StatusBar = Round(((lastRow - R) / lastRow) * 100, 0) & "% done"
            End If
        Next R
    End With
End Sub

Note that the progress is shown in the Status Bar at the left bottom of the screen.

Thank you for writing this! I'm testing now, and when setting the value of `ClmRng`, I'm getting "Run-time error '91': Object variable or With block variable not set" in an error box. — deskjet08, Mar 01 '19 at 15:22
Sorry about that. It's a syntax error. Setting a range requires the `Set` statement. The correct line of code should be `Set ClmRng = Worksheets("Competitive Set").ListObjects(TblName).DataBodyRange.Columns(C)` (now corrected above). — Variatus, Mar 02 '19 at 02:20

Sub slows down when called multiple times

1 Answers1