Hiding Rows takes Time

[jammer6_9]

Below code gives exactly what I wanted but it takes time to initiate? Is there any way to make it faster?


Sub HideEmptyRows()

LastRow = ActiveSheet.UsedRange.Row - 1 + _
ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For r = LastRow To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).EntireRow.Hidden = True
Next r



End Sub

[mdmackillop]

Sub HideEmptyRows()
Dim Rng As Range
Dim LastRow As Long
Application.ScreenUpdating = False
LastRow = ActiveSheet.UsedRange.Row - 1 + _
ActiveSheet.UsedRange.Rows.Count
Columns(1).Insert
Set Rng = Range(Cells(1, 1), Cells(LastRow, 1))
Rng.Formula = "=counta(B1:IV1)"
Rng.AutoFilter field:=1, Criteria1:=0
Set Rng = Rng.SpecialCells(xlCellTypeVisible)
Rng.AutoFilter
Rng.EntireRow.Hidden = True
Rng(1).EntireRow.Hidden = False
Columns(1).Delete
Application.ScreenUpdating = True
End Sub