Hide Row Macro Taking Long Time to Run

Question

Is there a way to make this code run faster? I am trying to hide rows that are blank across multiple worksheets.

Option Explicit

Private Sub HideRows_Click()

Dim ws As Worksheet, c As Range

    Application.ScreenUpdating = False
    On Error Resume Next

    For Each ws In ThisWorkbook.Worksheets
        Select Case ws.Name
        Case "Sheet1", "Sheet2", "Sheet3"
        'sheets to exclude
            'do nothing

        Case Else 'hide rows on these sheets
            For Each c In ws.Range("AJ16:AJ153,AJ157:AJ292")
                c.EntireRow.Hidden = c.Value = 0
            Next c
        End Select
    Next ws

    Application.ScreenUpdating = True

End Sub

Answer 1

Here are some of the changes made to your code with the intention of speeding it up:

• Turning off calculations, events, and status bar
• First grouping all values in AJ with no values via the Union() function and then calling EntireRow.Hide on that combined range

It was honestly pretty clean code to begin with!

Option Explicit

Private Sub HideRows_Click()

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With

    'On Error Resume Next

    Dim ws As Worksheet
    For Each ws In Worksheets

        Select Case ws.name
            Case "Sheet1", "Sheet2", "Sheet3" 'sheets to exclude
                'do nothing

            Case Else 'hide rows on these sheets
                Dim unioned As Range
                Set unioned = Nothing

                Dim c As Range
                For Each c In ws.Range("AJ16:AJ153,AJ157:AJ292")
                    If Len(c.Value2) = 0 Then
                        If unioned Is Nothing Then
                            Set unioned = c
                        Else
                            Set unioned = Union(unioned, c)
                        End If
                    End If
                Next c

                unioned.EntireRow.Hidden = True
        End Select

    Next ws

    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
    End With

End Sub