sub to delete rows is very slow

  • Thread starter Thread starter RITCHI
  • Start date Start date
R

RITCHI

Hi

I have quite a long procedure that conditionally formats a worksheet.
It calls a number of other procedures including the one below to delete
rows.
It works well for i=50 but beyond 500 is very slow. I need to check
over 3000rows
Any advice on how to speed things up would be appreciated.

Sub DeleteRows()
'deletes rows where number of characters in cells in column 1 is 0,
from bottom upwards
Dim i As Integer
Application.ScreenUpdating = False
With ActiveSheet
For i = 500 To 6 Step -1
If Len(Cells(i, 1)) = 0 Then
With Cells(i, 1).EntireRow
.Delete Shift:=xlUp
End With
End If
Next
End With
Application.ScreenUpdating = True
End Sub

Ritchi
 
may be quicker

lr=cells(rows.count,1).end(xlup).row
For i = lr To 6 Step -1
If Len(Cells(i, 1)) = 0 Then rows(i).Delete
Next
 
Saved from a previous post:

Turning calculation to manual, hiding the pagebreaks, and changing to normal
view can increase the speed.

You may want to do something like:

Option Explicit
Sub testme()

Dim CalcMode As Long
Dim ViewMode As Long

Application.ScreenUpdating = False

CalcMode = Application.Calculation
Application.Calculation = xlCalculationManual

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView

ActiveSheet.DisplayPageBreaks = False

'do the work

'put things back to what they were
Application.Calculation = CalcMode
ActiveWindow.View = ViewMode

End Sub
 
Also, turn of the display of page breaks at the start of the sub...
ActiveSheet.DisplayPageBreaks = False
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"RITCHI" <[email protected]>
wrote in message
Hi
I have quite a long procedure that conditionally formats a worksheet.
It calls a number of other procedures including the one below to delete
rows.
It works well for i=50 but beyond 500 is very slow. I need to check
over 3000rows
Any advice on how to speed things up would be appreciated.

Sub DeleteRows()
'deletes rows where number of characters in cells in column 1 is 0,
from bottom upwards
Dim i As Integer
Application.ScreenUpdating = False
With ActiveSheet
For i = 500 To 6 Step -1
If Len(Cells(i, 1)) = 0 Then
With Cells(i, 1).EntireRow
.Delete Shift:=xlUp
End With
End If
Next
End With
Application.ScreenUpdating = True
End Sub

Ritchi
 
Thanks Don
Brilliant - I'm trying to figure out your code but this has solved the
problem.

Ritchi
 
Back
Top