Speed up working script

Question

I have the following script which works great. The only thing is it takes a lot of time to run on a worksheet with 2000+ rows. Anyone know of a way to speed it up?

The code runs through the workbook and ignores the pages I do not want it to touch. Then, it runs through any pages that I want it to, looks for rows with a zero in column C and Column D and if found hides the row.

Here is the code:

Sub HideDoubleZeors()

Dim LR As Long, i As Long
Dim c As Variant

For Each ws In Worksheets
    Select Case ws.Name
        Case "Form1", _
                "Form 2", _
                "Form 3"
                'Do nothing on these tabs

        Case Else 'If not one of the above tab names then do this
With ws.Activate
    LR = ws.Range("B" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        With ws.Range("B" & i)
            For Each c In Range("B" & i)
                If c.Value <> "All Forms" _
                    And c.Value <> "Week One All Forms" _
                    And c.Offset(0, 1).Value = 0 _
                    And c.Offset(0, 1).Value <> vbNullString _
                    And c.Offset(0, 2).Value = 0 _
                    And c.Offset(0, 2).Value <> vbNullString _
                Then Rows(c.Row).Hidden = True
                Next c

        End With
       Next i
    End With
    End Select
Next ws
End Sub

Answer 1

For this particular task Union is quite slow

TestData: 4 Sheets, each with 10,000 rows (x 4); Rows to hide on each: 1,250 (Total 5,000)

Time: 4.641 sec   Union (with Array)
Time: 0.219 sec   AutoFilter

See this comparison on Code Review: Script to hide Excel rows where certain columns contain 0

.

Use AutoFilter

---

Public Sub HideDoubleZeorsAutoFilter()
    Dim ws As Worksheet, b1 As String, b2 As String, lr As Long, fc As Range, hid As Range

    OptimizeApp True
    For Each ws In Worksheets
        Select Case ws.Name
            Case "Form1", "Form 2", "Form 3"
            Case Else
                ws.Rows(1).Insert Shift:=xlDown
                lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
                Set hid = ws.Cells(lr + 1, "B")
                Set fc = ws.Range("B1:B" & lr)
                With ws.Range("B1:D" & lr)

                    b1 = "<>All Forms"
                    b2 = "<>Week One All Forms"

                   .AutoFilter Field:=1, Criteria1:=b1, Operator:=xlAnd, Criteria2:=b2
                   .AutoFilter Field:=2, Criteria1:="=0"
                   .AutoFilter Field:=3, Criteria1:="=0"

                    If fc.SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
                        Set hid = Union(hid, fc.SpecialCells(xlCellTypeVisible))
                       .AutoFilter
                        hid.EntireRow.Hidden = True
                    End If
                End With
                ws.Rows(1).Delete Shift:=xlUp
                ws.Activate
                ActiveWindow.ScrollRow = 1
        End Select
    Next ws
    Worksheets(1).Activate
    OptimizeApp False
End Sub

---

Private Sub OptimizeApp(ByVal speedUp As Boolean)
    Application.Calculation = IIf(speedUp, xlCalculationManual, xlCalculationAutomatic)
    Application.ScreenUpdating = Not speedUp
    Application.DisplayAlerts = Not speedUp
    Application.EnableEvents = Not speedUp
End Sub

Answer 2

Instead of hiding the lines one by one, use the union function to Collect that line. After that, hide them all at once.

Sub HideDoubleZeors()

Dim LR As Long, i As Long
Dim c As Range
Dim rngU As Range
For Each ws In Worksheets
    Select Case ws.Name
        Case "Form1", _
                "Form 2", _
                "Form 3"
                'Do nothing on these tabs

        Case Else 'If not one of the above tab names then do this
            With ws
                Set rngU = Nothing
                LR = .Range("B" & Rows.Count).End(xlUp).Row
                'For i = 1 To LR
                    'With ws.Range("B" & i)
                        For Each c In .Range("B1", "B" & LR)
                            If c.Value <> "All Forms" _
                                And c.Value <> "Week One All Forms" _
                                And c.Offset(0, 1).Value = 0 _
                                And c.Offset(0, 1).Value <> vbNullString _
                                And c.Offset(0, 2).Value = 0 _
                                And c.Offset(0, 2).Value <> vbNullString _
                            Then
                                If rngU Is Nothing Then
                                    Set rngU = c
                                Else
                                    Set rngU = Union(rngU, c)
                                End If
                            End If
                        Next c
                        If rngU Is Nothing Then
                        Else
                            rngU.EntireRow.Hidden = True
                        End If
            End With
    End Select
Next ws
End Sub