7
\$\begingroup\$

I have the following script which works, but 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.

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
\$\endgroup\$
  • 1
    \$\begingroup\$ Instead of checking the values individually you could just see if their sum is 0 \$\endgroup\$ – BruceWayne May 27 '18 at 2:13
8
\$\begingroup\$

The first rule of optimizing Excel when formatting: "TURN OFF SCREEN UPDATING"

 Application.ScreenUpdating = False

These line continuations are just ugly. They add nothing to the readability or functionality of the subroutine.

    Case "Form1", _
        "Form 2", _
        "Form 3"

I would remove the line continuations

   Case "Form1", "Form 2", "Form 3"

There are only a sew cases where it is advantageous to Select or Activate an Object. This isn't one of them. Watch: Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset)

With ws.Activate

I guess your original code might have needed this line: With ws.Range("B" & i) but now it's just leftover parts. Remove it.

I hate the old style where you first find the last row and then use it in a loop or Range. IMO, there isn't a good reason to do this with a simple loop or Range selection.

LR = ws.Range("B" & Rows.Count).End(xlUp).Row
  For i = 1 To LR

What's next..hmm. For Each Cell in My 1 Cell Range???? Have you watched the formationed Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset) yet???

For Each c In Range("B" & i)

Range("B" & i) isn't qualified to the ws. It is referencing the cells of the ActiveSheet. That's probably why you needed to activate the worksheet.

Often it is necessary to unhide all the cells on the worksheet before you reprocess the worksheet. It probably doesn't apply to this scenario but I thought that I would mention it.

This statement seems somewhat redundant but I'll let someone else handle it.

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 _

Here is the real problem. You are hiding each row individually. The preferred method is to create one large Range (per worksheet) and hide all the cells at once. The easiest way to do this is to use Application.Union.

Then Rows(c.Row).Hidden = True

The other method collects the range addresses and then creates a range from them. Although faster, its not worth the extra work to processes a few thousand rows.

Rows(c.Row).Hidden = True works but again its ugly use c.EntireRow.Hidden = True

A better way:

Sub HideDoubleZeors()
    Dim ws As Worksheet
    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
                ProcessWorksheet ws
        End Select
    Next
End Sub

Private Sub ProcessWorksheet(ws As Worksheet)
    Application.ScreenUpdating = False
    Dim cell As Variant, MyRows As Range
    With ws
        For Each cell In ws.Range("B1", .Range("B" & .Rows.Count).End(xlUp))
            If cell.Value <> "All Forms" And cell.Value <> "Week One All Forms" _
               And cell.Offset(0, 1).Value = 0 And cell.Offset(0, 1).Value <> vbNullString _
               And cell.Offset(0, 2).Value = 0 And cell.Offset(0, 2).Value <> vbNullString Then
                If MyRows Is Nothing Then
                    Set MyRows = cell
                Else
                    Set MyRows = Union(MyRows, cell)
                End If
            End If
        Next
    End With

    If Not MyRows Is Nothing Then MyRows.EntireRow.Hidden = True
    Application.ScreenUpdating = True
End Sub

Hopefully the OP gets more out of this than just some free code.

Good Luck and don't forget to watch that video!!

\$\endgroup\$
  • \$\begingroup\$ I think between the two of us we have covered everything that can be done to speed it up ... except convert the "C" and "D" columns to arrays and process that ! \$\endgroup\$ – AJD May 26 '18 at 9:44
  • \$\begingroup\$ typo: "only a sew cases" -> "only a few cases" \$\endgroup\$ – David Conrad May 26 '18 at 15:28
  • \$\begingroup\$ I am going to watch the videos now :) Thank you for the in depth explanation, that will helps me out immensely. I am going to go over the other comments as well and see what I can do to clean it all up now. \$\endgroup\$ – Mike F. May 29 '18 at 10:08
7
\$\begingroup\$

The previous two answers from AJD and user109261 have already provided very good reviews of the code (+1 to both, and the question), so I'll focus only on performance

I did a comparative review between 6 different versions (usual optimization techniques), and found one unexpected result - Union is slow (for this particular task)


.

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

Time: 4.311 sec   (Ini)
Time: 0.973 sec   (IniScreen)
Time: 1.047 sec   (RangeOptimized)
Time: 0.791 sec   (RangeArray)
Time: 4.641 sec   (RangeArrayUnion)
Time: 0.219 sec   (AutoFilter)

.

2 Test Subs


Option Explicit

Public Sub TimeAllVersions()

   'Total Sheets: Worksheets.Count - 3
    Debug.Print "Test Data: 4 Sheets, each with 10,000 rows (x 4), hide: 5,000:" & vbCrLf

    HideEachT "Ini"
    HideEachT "IniScreen"
    HideEachT "RangeOptimized"
    HideEachT "RangeArray"
    HideEachT "RangeArrayUnion"
    HideEachT "AutoFilter"
End Sub

Public Sub HideEachT(ByVal subId As String)
    Dim t As Double: t = Timer
    Select Case subId
        Case "Ini":             HideDoubleZeorsIni
        Case "IniScreen":       HideDoubleZeorsIniScreenOff
        Case "RangeOptimized":  HideDoubleZeorsRangeOptimized
        Case "RangeArray":      HideDoubleZeorsRangeArray
        Case "RangeArrayUnion": HideDoubleZeorsRangeArrayUnion
        Case "AutoFilter":      HideDoubleZeorsAutoFilter
    End Select
    Debug.Print "Time: " & Format(Timer - t, "0.000") & " sec   (" & subId & ")"
    UnHideAll
End Sub

.

The 6 Versions:


1 - Initial version (to compare, using the same test data)

Public Sub HideDoubleZeorsIni()
    Dim lr As Long, i As Long, c As Variant, ws As Worksheet

    For Each ws In Worksheets
        Select Case ws.Name
            Case "Form1", "Form 2", "Form 3"    'Do nothing on these tabs
            Case Else                           'Else 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
                                End If
                            Next c
                        End With
                    Next i
                End With
        End Select
    Next ws
End Sub

.

2 - Initial version with Screen Off (surprisingly fast, in spite of the weird nesting)

Public Sub HideDoubleZeorsIniScreenOff()
    Dim lr As Long, i As Long, c As Variant, ws As Worksheet

    OptimizeApp True
    For Each ws In Worksheets
        Select Case ws.Name
            Case "Form1", "Form 2", "Form 3"    'Do nothing on these tabs
            Case Else                           'Else 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
                                End If
                            Next c
                        End With
                    Next i
                End With
        End Select
    Next ws
    OptimizeApp False
End Sub

.

3 - Optimized for maintainability (and Screen Off)

Public Sub HideDoubleZeorsRangeOptimized()
    Dim ws As Worksheet, lr As Long, r As Long, b As String, c As Variant, d As Variant
    Dim bCnd As Boolean, cCnd As Boolean, dCnd As Boolean

    OptimizeApp True
    For Each ws In Worksheets
        Select Case ws.Name
            Case "Form1", "Form 2", "Form 3"
            Case Else

                lr = ws.Range("B" & ws.Rows.Count).End(xlUp).Row

                For r = 1 To lr

                    b = ws.Cells(r, "B").Value2
                    c = ws.Cells(r, "C").Value2
                    d = ws.Cells(r, "D").Value2

                    bCnd = b <> "All Forms" And b <> "Week One All Forms"
                    cCnd = c = 0 And Len(c) > 0
                    dCnd = d = 0 And Len(d) > 0

                    ws.Rows(r).Hidden = (bCnd And cCnd And dCnd)
                Next
        End Select
    Next ws
    OptimizeApp False
End Sub

.

4 - Using Arrays

Public Sub HideDoubleZeorsRangeArray()
    Dim ws As Worksheet, lr As Long, r As Long, b As String, c As Variant, d As Variant
    Dim bCnd As Boolean, cCnd As Boolean, dCnd As Boolean, arr As Variant

    OptimizeApp True
    For Each ws In Worksheets
        Select Case ws.Name
            Case "Form1", "Form 2", "Form 3"
            Case Else

                lr = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
                arr = ws.Range("B1:D" & lr).Value2

                For r = 1 To lr

                    b = arr(r, 1)
                    c = arr(r, 2)
                    d = arr(r, 3)

                    bCnd = b <> "All Forms" And b <> "Week One All Forms"
                    cCnd = c = 0 And Len(c) > 0
                    dCnd = d = 0 And Len(d) > 0

                    ws.Rows(r).Hidden = (bCnd And cCnd And dCnd)
                Next
        End Select
    Next ws
    OptimizeApp False
End Sub

.

5 - Using Arrays and Union

Public Sub HideDoubleZeorsRangeArrayUnion()
    Dim ws As Worksheet, lr As Long, r As Long, b As String, c As Variant, d As Variant
    Dim bCnd As Boolean, cCnd As Boolean, dCnd As Boolean, arr As Variant, hid As Range

    OptimizeApp True
    For Each ws In Worksheets
        Select Case ws.Name
            Case "Form1", "Form 2", "Form 3"
            Case Else

                lr = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
                arr = ws.Range("B1:D" & lr).Value2

                Set hid = ws.Range("B" & lr)

                For r = 1 To lr

                    b = arr(r, 1)
                    c = arr(r, 2)
                    d = arr(r, 3)

                    bCnd = b <> "All Forms" And b <> "Week One All Forms"
                    cCnd = c = 0 And Len(c) > 0
                    dCnd = d = 0 And Len(d) > 0

                    If bCnd And cCnd And dCnd Then Set hid = Union(hid, ws.Range("B" & r))
                Next
                hid.EntireRow.Hidden = True
        End Select
    Next ws
    OptimizeApp False
End Sub

.

6 - Using 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

.

Utils

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

Public Sub UnHideAll()
    Dim ws As Worksheet, lr As Long, r As Long
    Dim bVal As Variant, cVal As Variant, dVal As Variant, bCond As Boolean

    OptimizeApp True
    For Each ws In Worksheets
        Select Case ws.Name
            Case "Form1", "Form 2", "Form 3"
            Case Else
                ws.UsedRange.Rows.Hidden = False
        End Select
    Next ws
    OptimizeApp False
End Sub

.

Test Data - Before - All 4 sheets are the same

TestDataBefore


.

Test Data - After - All test results are the same

TestDataAfter


\$\endgroup\$
  • \$\begingroup\$ Scalability - case 4 \$\endgroup\$ – Raystafarian May 27 '18 at 22:55
6
\$\begingroup\$

Your big issue is simply that you are doing too much. You are doing calculations and comparisons that you simply do not need to do.

A few comments.

  • Don't skimp on variable names. Good names help in understanding the code.
  • Use With properly, Your use of With is confusing and, while I have tried to fix something in the code below I will have introduced errors which means the code does not work as desired.
  • Don't Activate or Select in VBA unless you specifically want to display something to the user.
  • Indent your code properly. The level of indenting (see code below) shows there is a problem.
  • Select Case is not an elegant way to do a simple If-Then

I have provided an additional code example that addresses the points above.


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
                LR = .Range("B" & .Rows.Count).End(xlUp).Row
                For i = 1 To LR
                    With .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

Additional code example - tidy up

Option Explicit
Sub HideDoubleZeroes()
Dim tLastRow As Long, tIterator As Long
Dim tCell As Variant
Dim tWS as Worksheet
Dim tSkipWS as Boolean
Dim tCanHideRow as Boolean

    For Each tWS In Worksheets
        tSkipWS = (tws.Name = "Form1") OR (tws.Name = "Form2") OR (tws.Name = "Form3")
        if Not tSkipWS then
            tLastRow = tWS.Range("B" & .Rows.Count).End(xlUp)
            For Each tCell in tWS.Range("B1:B" & tLastRow)
                tCanHideRow = tCell.Value <> "All Forms"
                tCanHideRow = tCanHideRow AND tCell.Value.Offset(0, 1).Value = 0
                tCanHideRow = tCanHideRow AND tCell.Value.Offset(0, 2).Value = 0
                Rows(tCell.Row).Hidden = tCanHideRow
            Next tCell    
         End If
    Next tWS
End Sub
\$\endgroup\$
  • \$\begingroup\$ What is the t prefix about? \$\endgroup\$ – t3chb0t May 26 '18 at 7:26
  • 1
    \$\begingroup\$ @t3chb0t: "t" is my own style/prefix to show the scope of a variable. It is my own preference, others will use a different style. \$\endgroup\$ – AJD May 26 '18 at 9:17
  • 1
    \$\begingroup\$ @t3chb0t: should have added "t" - temporary, scoped to the function/subroutine :-) \$\endgroup\$ – AJD May 26 '18 at 9:41
  • 1
    \$\begingroup\$ @t3chb0t: Just as well that I am not a professional coder then! Helps me avoid scope issues or conflicts between some calls/functions/methods/properties/subroutines. \$\endgroup\$ – AJD May 26 '18 at 9:46
  • 1
    \$\begingroup\$ @t3chb0t - not all variables are "temporary". Some have a class/module scope. Rarely, but some also have a global scope. \$\endgroup\$ – AJD May 26 '18 at 9:47

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.