Speed up hide macro

MattHammer

New Member
Joined
Apr 21, 2010
Messages
4
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
 

Some videos you may like

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"

SamTYler

Well-known Member
Joined
Mar 10, 2004
Messages
784
See if this is significantly faster
Code:
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

New Member
Joined
Apr 21, 2010
Messages
4
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

Well-known Member
Joined
Mar 10, 2004
Messages
784
Try adding "New"
Rich (BB code):
Dim SheetsToCheck As New Collection

Sorry 'bout dat
 

MattHammer

New Member
Joined
Apr 21, 2010
Messages
4

ADVERTISEMENT

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

Well-known Member
Joined
Mar 10, 2004
Messages
784
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

Well-known Member
Joined
Mar 10, 2004
Messages
784

ADVERTISEMENT

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

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,384
In SamTYler's code (post #6), I think this...
Set Rng = Range("F13:F2000")

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

MattHammer

New Member
Joined
Apr 21, 2010
Messages
4
That works. Its about 40% faster as far as I can gauge. Thanks so much for your help.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,295
Messages
5,600,789
Members
414,405
Latest member
Zaurb

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top