VBA Macro is excruciatingly slow-CodePudding

Currently i have a perfectly functioning VBA Macro. Does everything it is required to. However, i do need some advice and help on speeding this macro up as it takes a LONG time to get things done. This macro takes aroung 5 minutes to sort through around 4k-5k populated rows, which then it hides some of the rows.

How this macro works is that it will sort through Column A, sorting through the names and comparing it to a list in Sheet1, where if the name matches the list in sheet1, it will proceed to hide the row. Thanks in advance.

 Sub FilterNameDuplicate()
   Application.ScreenUpdating = False
 
    Dim iListCount As Integer
    Dim iCtr As Integer
    Dim a As Long
    Dim b As Long
    Dim c As Long
    Dim D As Long
    a = Worksheets("Default").Cells(Rows.Count, "G").End(xlUp).Row
For c = 1 To a
     b = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
        For D = 1 To b
            If StrComp(Worksheets("Sheet1").Cells(D, "A"), (Worksheets("Default").Cells(c, "G")), vbTextCompare) = 0 Then
                Worksheets("Default").Rows(c).EntireRow.Hidden = True
            End If
        Next
    Next
    
    Application.ScreenUpdating = True
    MsgBox "Done"
    End Sub

CodePudding user response：

Trying adding in this, it speeds up by turning off screen updating, events, animations etc, this should speed it up a bit!

At the start of your code add in this sub

Call TurnOffCode

At the end of your code add in this sub

Call TurnOnCode

This is what they should both look like

Sub TurnOffCode() 'Used to turn off settings to make workbook run faster
Application.Calculation = xlCalculationManual 'Set calculations to manual
Application.ScreenUpdating = False 'Turns off screen updating
Application.EnableEvents = False 'Turns off events
Application.EnableAnimations = False 'Turns off animations
Application.DisplayStatusBar = False 'Turns off display status bar
Application.PrintCommunication = False 'Turns off print communications
End Sub

Sub TurnOnCode() 'Used to turn settings back on to normal
Application.Calculation = xlCalculationAutomatic 'Set calculations to automatic
Application.ScreenUpdating = True 'Turns on screen updating
Application.EnableEvents = True 'Turns on events
Application.EnableAnimations = True 'Turns on animations
Application.DisplayStatusBar = True 'Turns on display status bar
Application.PrintCommunication = True 'Turns on print communications
End Sub

CodePudding user response：

All of your accesses to the worksheet really slows things down. Much faster to use VBA arrays.

You can eliminate some of the looping by using the Range.Find method to determine if there are duplicates of the names on Default in Sheet1.

We collect the non-duplicated names (in a Collection) and then create an array to use as the argument for the Range.Filter method (which will effectively hide the entire row).

Accordingly:

Option Explicit
Sub FilterNameDuplicate()
    Dim ws1 As Worksheet, wsD As Worksheet
    Dim v1 As Variant, vD As Variant, r1 As Range, rD As Range
    Dim col As Collection
    Dim R As Range, I As Long, arrNames() As String

With ThisWorkbook
    Set ws1 = .Worksheets("Sheet1")
    Set wsD = .Worksheets("Default")
End With

With ws1
    Set r1 = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
    v1 = r1
End With

With wsD
    Set rD = Range(.Cells(1, 7), .Cells(.Rows.Count, 7).End(xlUp))
    vD = rD
End With

'collect names on Default that are not on Sheet1
Set col = New Collection
With r1
    For I = 2 To UBound(vD, 1)
        Set R = .Find(what:=vD(I, 1), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
        If R Is Nothing Then col.Add vD(I, 1)
    Next I
End With

'Filter to include those names
Application.ScreenUpdating = False
If wsD.FilterMode Then wsD.ShowAllData

ReDim arrNames(1 To col.Count)
For I = 1 To col.Count
    arrNames(I) = col(I)
Next I

rD.AutoFilter field:=1, Criteria1:=arrNames, Operator:=xlFilterValues

End Sub