Macro Takes Long Time To Run

[Monk]

Hello

The macro below is taking an excessive amount of time to run. It takes about
2 or 3 minutes to complete. Can someone please review the code and see
whether there is a way to speed it up?

Thanks

Monk


Application.ScreenUpdating = False
Columns("A").Select
Selection.EntireColumn.Hidden = False
Rows("10:10").Select
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Selection.RowHeight = 30#
Rows("11:1251").Select
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Selection.RowHeight = 12.75
Dim c As Range
For Each c In Range("A11:A1250")
If c.Value = "" Then
Rows(c.Row).Hidden = True
Else
Rows(c.Row).Hidden = False
End If
Next c
Range("I2").Select
Application.ScreenUpdating = True
End Sub

 

[Jon Peltier]

I suspect the hiding of rows is your bottleneck, even though you use
Application.ScreenUpdating. Instead of hiding one row at a time, it is
faster to keep track of rows in a range, and hide the range all at once.

This is a shortened test version of your code:

Sub Test1()
Dim c As Range
Dim t As Double
Dim i As Long
t = Timer
Application.ScreenUpdating = False
For i = 1 To 100
ActiveSheet.Range("A1:A40").EntireColumn.Hidden = False
For Each c In ActiveSheet.Range("A1:A40").Cells
If c.Value = "" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next
Next
Application.ScreenUpdating = True
Debug.Print Timer - t
End Sub

I ran this five times, with an average elapsed time of 5.8 seconds.

This does the same by adding each cell 'c' to a range 'r', then hiding this
multicell range:

Sub Test3()
Dim c As Range
Dim r As Range
Dim t As Double
Dim i As Long
t = Timer
Application.ScreenUpdating = False
For i = 1 To 100
ActiveSheet.Range("A1:A40").EntireColumn.Hidden = False
Set r = Nothing
For Each c In ActiveSheet.Range("A1:A40").Cells
If Len(c.Value) = 0 Then
If r Is Nothing Then
Set r = c
Else
Set r = Union(r, c)
End If
End If
Next
r.EntireRow.Hidden = True
Next
Application.ScreenUpdating = True
Debug.Print Timer - t
End Sub

Five iterations averaged 1.6 seconds.

- Jon

 

[Jim Cone]

This ran pretty fast too. However, it was run on xl2003 not on XL2007.
'--
Sub tract()
Dim c As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Columns("A:O").EntireColumn.Hidden = False
With Rows(10).Font
.Name = "Arial"
.Size = 10
End With
Rows(10).RowHeight = 30
With Rows("11:1251").Font
.Name = "Arial"
.Size = 10
End With
Rows("11:1251").RowHeight = 12.75

For Each c In Range("A11:A1250").Cells
c.EntireRow.Hidden = IsEmpty(c)
Next c

Range("I2").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
--
Jim Cone
Portland, Oregon USA




"Monk" <[email protected]>
wrote in message
Hello
The macro below is taking an excessive amount of time to run. It takes about
2 or 3 minutes to complete. Can someone please review the code and see
whether there is a way to speed it up?
Thanks
Monk

Application.ScreenUpdating = False
Columns("A").Select
Selection.EntireColumn.Hidden = False
Rows("10:10").Select
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Selection.RowHeight = 30#
Rows("11:1251").Select
With Selection.Font
.Name = "Arial"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
End With
Selection.RowHeight = 12.75
Dim c As Range
For Each c In Range("A11:A1250")
If c.Value = "" Then
Rows(c.Row).Hidden = True
Else
Rows(c.Row).Hidden = False
End If
Next c
Range("I2").Select
Application.ScreenUpdating = True
End Sub

 

[Monk]

Thanks Jim this works much quicker.

However the code to hide the rows if empty doesn't appear to work. I am
guessing this is because there is a "" value in the cell as a result of a
formula. Can you advise how this line should be amended to hide rows if there
is a "" value in the A column cell?

Cheers

 

[Simon Lloyd]

Jim it does run a little slower in 2007 than Jons' code however it wa
marginal

This ran pretty fast too. However, it was run on xl2003 not on XL2007
'-
Sub tract(
Dim c As Rang
Application.ScreenUpdating = Fals
Application.Calculation = xlCalculationManua
Columns("A:O").EntireColumn.Hidden = Fals
With Rows(10).Fon
.Name = "Arial
.Size = 1
End Wit
Rows(10).RowHeight = 3
With Rows("11:1251").Fon
.Name = "Arial
.Size = 1
End Wit
Rows("11:1251").RowHeight = 12.7

For Each c In Range("A11:A1250").Cell
c.EntireRow.Hidden = IsEmpty(c
Next

Range("I2").Selec
Application.Calculation = xlCalculationAutomati
Application.ScreenUpdating = Tru
End Su
-
Jim Con
Portland, Oregon US




"Monk" <[email protected]
wrote in messag
Hell
The macro below is taking an excessive amount of time to run. It take
abou
2 or 3 minutes to complete. Can someone please review the code and se
whether there is a way to speed it up
Thank
Mon

Application.ScreenUpdating = Fals
Columns("A").Selec
Selection.EntireColumn.Hidden = Fals
Rows("10:10").Selec
With Selection.Fon
.Name = "Arial
.Size = 1
.Strikethrough = Fals
.Superscript = Fals
.Subscript = Fals
.OutlineFont = Fals
.Shadow = Fals
.Underline = xlUnderlineStyleNon
End Wit
Selection.RowHeight = 30
Rows("11:1251").Selec
With Selection.Fon
.Name = "Arial
.Size = 1
.Strikethrough = Fals
.Superscript = Fals
.Subscript = Fals
.OutlineFont = Fals
.Shadow = Fals
.Underline = xlUnderlineStyleNon
End Wit
Selection.RowHeight = 12.7
Dim c As Rang
For Each c In Range("A11:A1250"
If c.Value = "" The
Rows(c.Row).Hidden = Tru
Els
Rows(c.Row).Hidden = Fals
End I
Next
Range("I2").Selec
Application.ScreenUpdating = Tru
End Su

--
Simon Lloy

Regards,
Simon Lloyd
'The Code Cage' (http://www.thecodecage.com

 

[Monk]

Hi Jon

I have used your code as shown below. I must have made an error somewhere as
it still takes a couple of minutes to complete. Are you able to advise where
my error is?

Monk


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Columns("A").EntireColumn.Hidden = False
With Rows(10).Font
.Name = "Arial"
.Size = 10
End With
Rows(10).RowHeight = 30
With Rows("11:1251").Font
.Name = "Arial"
.Size = 10
End With
Rows("11:1251").RowHeight = 12.75

Dim c As Range
Dim t As Double
Dim i As Long
t = Timer
For i = 1 To 100
ActiveSheet.Range("A11:A1250").EntireColumn.Hidden = False
For Each c In ActiveSheet.Range("A11:A1250").Cells
If c.Value = "" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next
Next
Debug.Print Timer - t
Range("I2").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

 

[Jon Peltier]

Monk -

I was showing a comparison between two techniques, a slow way and a fast
way. Each looped 100 times to give timer values that could be compared. You
took the slower code, and kept in the loop. So yeah, it's going to be slow.

What you need to do is replace this slow bit of your code:

Dim c As Range
For Each c In Range("A11:A1250")
If c.Value = "" Then
Rows(c.Row).Hidden = True
Else
Rows(c.Row).Hidden = False
End If
Next c

with this faster bit:

Dim c As Range
Dim r As Range
For Each c In Range("A11:A1250")
If c.Value = "" Then
If r is nothing then
Set r = c
else
Set r = Union(r. c)
endif
End If
Next c
r.EntireRow.Hidden = True

- Jon

 

[Jon Peltier]

Change

c.EntireRow.Hidden = IsEmpty(c)

to

c.EntireRow.Hidden = (Len(c.Value) = 0)

- Jon

 

[Jon Peltier]

I didn't try mine in 2007, but it will be slower there than in 2003. 2002
would probably be fastest of all.

- Jon

 

[Monk]

Thanks Jon. Sorry to be a pain but I am getting a "Compile Error: Argument
not optional" response on the Union (r,c) line

 

[Dave Peterson]

Jon had a typo in his code:
Set r = Union(r. c)
should have been:
Set r = Union(r, c)

But in your post, you used a comma. So I'm not sure if it's something else...

 

[Jon Peltier]

DOH!!

- Jon