trjhtr

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

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!!

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

.

Test Data - After - All test results are the same

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