[SOLVED] The Macro takes very long time to apply on a table

The Macro takes very long time to apply on a table

I have a worksheet with a table over 400 rows and I have a code to hide some rows based on a cell value if date in the cell is older than TODAY() with 90 days. and it works well but unfortunately it takes a very long time to apply on all the table and I can see that it goes throgh rows one after one which is trastrating. any suggestion please.

here is my code

Sub hideolderdates()

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Database")

wsLR = ws.Cells(Rows.Count, 9).End(xlUp).Row

For x = 5 To wsLR
    'analyze date, see if its 3 weeks or older
    If ws.Cells(x, 9) <= Date - 90 Then
     'hide
     ws.Range("a" & x).EntireRow.Hidden = True
           
    End If
Next x

End Sub

Solution

You could place all your dates into an array as that will be faster than referencing the worksheet on each pass of your loop.

You could also add Application.ScreenUpdating = False and Application.EnableEvents = False as @Shrotter indicates in his comment - remember to turn them back to True at the end of the procedure.

With just 881 dates in cells it took about 0.02 seconds to execute.

''''''''''''''''''''''''''''''''''''''''''''''''''
'This section will time how long the procedure takes to run.
'Remove if you want.

Private StartTime As Double ' - must go at very top of module.

Public Sub RunTimeStart()
    StartTime = Timer
End Sub

Public Sub RunTimeEnd()
    MsgBox "Executed in " & Round(Timer - StartTime, 2) & " seconds.", vbInformation + vbOKOnly
End Sub

'End of timer section
'''''''''''''''''''''''''''''''''''''''''''''''''''

Public Sub HideOlderDates()

    RunTimeStart 'Remove to remove timer.

    With ThisWorkbook.Worksheets("Database")
    
        'Last row number.
        Dim wsLR As Long
        wsLR = .Cells(.Rows.Count, 9).End(xlUp).Row
        
        'Get reference to cells containing dates and place values into an array.
        Dim DateCol As Variant
        DateCol = .Range(.Cells(5, 9), .Cells(wsLR, 9))
        
        'Look at each date within the array.
        'If it's older than 90 days then add to the RngToHide range.
        '+4 is added to the value of x so it references the correct row on the sheet.
        Dim RngToHide As Range
        Dim x As Long
        For x = 1 To UBound(DateCol)
            If IsDate(DateCol(x, 1)) Then
                If CDate(DateCol(x, 1)) <= Date - 90 Then
                    If RngToHide Is Nothing Then
                        Set RngToHide = .Rows(x + 4)
                    Else
                        Set RngToHide = Union(RngToHide, .Rows(x + 4))
                    End If
                End If
            End If
        Next x
        
        'Hide the rows in RngToHide.
        RngToHide.EntireRow.Hidden = True
        
    End With
    
    RunTimeEnd 'Remove to remove timer.

End Sub