View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Jon Peltier Jon Peltier is offline
external usenet poster
 
Posts: 6,582
Default Macro Takes Long Time To Run

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
-------
Jon Peltier, Microsoft Excel MVP
Peltier Technical Services, Inc.
http://PeltierTech.com/WordPress/
_______


"Monk" 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:o").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