Speed up hide macro

[MattHammer]

Hi all,
I am trying to hide rows in multiple worksheets with multiple criteria. I have a code that works it just takes a few hours on an idle machine to run. Any suggestions to make the following code run faster?




Sub Table7RowHide()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim c As Object

Dim range1 As range
Dim range2 As range
Dim range3 As range
Dim range4 As range
Dim range5 As range
Dim range6 As range
Dim range7 As range
Dim range8 As range
Dim range9 As range
Dim range10 As range
Dim range11 As range


'If sheet names are different/excluded modify/delete set
'command below and hide command

Set range1 = Sheets("xxx").range("f10:f2000")
Set range2 = Sheets("xxx").range("f10:f2000")
Set range3 = Sheets("xxx").range("f10:f2000")
Set range4 = Sheets("xxx").range("f10:f2000")
Set range5 = Sheets("xxx").range("f10:f2000")
Set range6 = Sheets("xxx").range("f10:f2000")
Set range7 = Sheets("xxx").range("f10:f2000")
Set range8 = Sheets("xxx").range("f10:f2000")
Set range9 = Sheets("xxx").range("f10:f2000")
Set range10 = Sheets("xxx").range("f10:f2000")
Set range11 = Sheets("xxx").range("e26:e160")

For Each c In range1
If c.Value = "0" Or c.Value = "NA" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c
For Each c In range2
If c.Value = "0" Or c.Value = "NA" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c

For Each c In range3
If c.Value = "0" Or c.Value = "NA" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c

For Each c In range4
If c.Value = "0" Or c.Value = "NA" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c
For Each c In range5
If c.Value = "0" Or c.Value = "NA" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c

For Each c In range6
If c.Value = "0" Or c.Value = "NA" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c
For Each c In range7
If c.Value = "0" Or c.Value = "NA" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c

For Each c In range8
If c.Value = "0" Or c.Value = "NA" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c

For Each c In range9
If c.Value = "0" Or c.Value = "NA" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c

For Each c In range10
If c.Value = "0" Or c.Value = "NA" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c

For Each c In range11
If c.Value = "0" Or c.Value = "NA" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c


Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.Calculate
End Sub

 

[SamTYler]

See if this is significantly faster

Sub Table7RowHide()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Cel As Range
Dim Rng As Range
Dim Sht As Worksheet
Dim SheetsToCheck As Collection
'Fill the collection with the first ten sheets
   SheetsToCheck.Add (Sheets("xx1"))
   SheetsToCheck.Add (Sheets("xxetc"))
   SheetsToCheck.Add (Sheets("xx10"))
For Each Sht In SheetsToCheck
   Sht.Rows.EntireRow.Hidden = False 'Only needed if there may
                                     'be hidden rows at run time
   Set Rng = Range("f10:f2000")
      For Each Cel In Rng
         If Value = "0" _
         Or Value = "NA" Then _
            Cel.EntireRow.Hidden = True
      Next Cel
Next Sht
Sheets("xxx11").Rows.EntireRow.Hidden = False 'See above
Set Rng = Sheets("xxx11").Range("e26:e160")
      For Each Cel In Rng
         If Cel.Value = "0" _
         Or Cel.Value = "NA" Then _
            Cel.EntireRow.Hidden = True
      Next Cel

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.Calculate
End Sub

 

[MattHammer]

I am getting an error when the SheetsToCheck.Add runs

Object doesn't support this property of method

I am going to look for a solution but if anyone has any ideas...

 

[SamTYler]

Try adding "New"

Dim SheetsToCheck As New Collection

Sorry 'bout dat

 

[MattHammer]

Same thing
This is what I have

Sub Table7RowHidetest()

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Cel As range
Dim Rng As range
Dim Sht As Worksheet
Dim SheetsToCheck As New Collection


'Fill the collection
SheetsToCheck.Add (Sheets("TresAdol"))
SheetsToCheck.Add (Sheets("TresChild"))
SheetsToCheck.Add (Sheets("Waterman"))
SheetsToCheck.Add (Sheets("CommW"))
SheetsToCheck.Add (Sheets("ConstW"))
SheetsToCheck.Add (Sheets("ResA-surface"))
SheetsToCheck.Add (Sheets("ResC-surface"))
SheetsToCheck.Add (Sheets("ResA-subsurface"))
SheetsToCheck.Add (Sheets("ResC-subsurface"))
For Each Sht In SheetsToCheck
Sht.Rows.EntireRow.Hidden = False

Set Rng = range("f13:f2000"
For Each Cel In Rng
If Cel.Value = "0" _
Or Cel.Value = "NA" Then _
Cel.EntireRow.Hidden = True
Next Cel
Next Sht


Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.Calculate
End Sub

 

[SamTYler]

Checking the help file for Collection.Add, I saw that the paren's weren't supposed to be there.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Table7RowHidetest()<br><br>Application.Calculation = xlCalculationManual<br>Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> Cel <SPAN style="color:#00007F">As</SPAN> Range<br><SPAN style="color:#00007F">Dim</SPAN> Rng <SPAN style="color:#00007F">As</SPAN> Range<br><SPAN style="color:#00007F">Dim</SPAN> Sht <SPAN style="color:#00007F">As</SPAN> Worksheet<br><SPAN style="color:#00007F">Dim</SPAN> SheetsToCheck <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">New</SPAN> Collection<br><br><br><SPAN style="color:#007F00">'Fill the collection</SPAN><br>SheetsToCheck.Add Sheets("TresAdol")<br>SheetsToCheck.Add Sheets("TresChild")<br>SheetsToCheck.Add Sheets("Waterman")<br>SheetsToCheck.Add Sheets("CommW")<br>SheetsToCheck.Add Sheets("ConstW")<br>SheetsToCheck.Add Sheets("ResA-surface")<br>SheetsToCheck.Add Sheets("ResC-surface")<br>SheetsToCheck.Add Sheets("ResA-subsurface")<br>SheetsToCheck.Add Sheets("ResC-subsurface")<br><SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> Sht <SPAN style="color:#00007F">In</SPAN> SheetsToCheck<br>Sht.Rows.EntireRow.Hidden = <SPAN style="color:#00007F">False</SPAN><br><br><SPAN style="color:#00007F">Set</SPAN> Rng = Range("f13:f2000")<br><SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> Cel <SPAN style="color:#00007F">In</SPAN> Rng<br><SPAN style="color:#00007F">If</SPAN> Cel.Value = "0" _<br>Or Cel.Value = "NA" Then _<br>Cel.EntireRow.Hidden = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">Next</SPAN> Cel<br><SPAN style="color:#00007F">Next</SPAN> Sht<br><br><br>Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br>Application.Calculation = xlCalculationAutomatic<br>Application.Calculate<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br></FONT>

 

[SamTYler]

I tested the above with one sheet and a few entries in Col "F" andf it worked ok after taking out the parens after "Add"

 

[AlphaFrog]

In SamTYler's code (post #6), I think this...
Set Rng = Range("F13:F2000")

Should be this...
Set Rng = Sht.Range("F13:F2000")

 

[MattHammer]

That works. Its about 40% faster as far as I can gauge. Thanks so much for your help.