Slow Macro

[Casey]

Hello,
I have a macro which checks a cell to see if its blank and then if it is it deletes the row. I originally used it to check 96 rows for which it was fine. But now I have to use it for 15500 rows and it tkes over 10 min. Does anyone know of a way to do this faster? Ive included the code below
Thanks for any help
Casey
Dim Counter
Dim i As Integer
' Input box to determine the total number of rows in the worksheet.
Counter = 15500
ActiveCell.Select
' Loops through the desired number of rows.
For i = 1 To Counter
' Checks to see if the active cell is blank.
If ActiveCell = "" Then
Selection.EntireRow.Delete

' Decrements count each time a row is deleted. This ensures
' that the macro will not run past the last row.
Counter = Counter - 1
Else
' Selects the next cell.
ActiveCell.Offset(1, 0).Select
End If

Next i

 

[Russell Hauf]

One thing would be to turn the screen updating off (Application.ScreenUpdating = False). Another would be to not actually select any cells. Also, your loop should go from the bottom to the top so you don't have to change your "counter" (or row) variable. Change the 1 in "Cells(i, 1)" to the column that you are checking for values/text. Try the following:<pre><font color='#000000'><font color='#000080'>Sub</font> DeleteBlankRows()<font color='#000080'>Dim</font> Counter<font color='#000080'>As</font><font color='#000080'>Long</font><font color='#000080'>Dim</font> i<font color='#000080'>As</font><font color='#000080'>Long</font>

Counter = 15500

Application.ScreenUpdating = False<font color='#008000'>' Loops through the desired number of rows.</font><font color='#000080'>For</font> i = Counter To 1 Step -1<font color='#008000'>' Checks to see if the cell in the current row is blank.</font><font color='#000080'>If</font> Cells(i, 1) = ""<font color='#000080'>Then</font>
Cells(i, 1).EntireRow.Delete<font color='#000080'>End</font><font color='#000080'>If</font><font color='#000080'>Next</font> i

Application.ScreenUpdating = True<font color='#000080'>End</font><font color='#000080'>Sub</font></font></pre>

Hope this helps,

Russell
This message was edited by Russell Hauf on 2002-02-28 08:45

 

[NateO]

Two other things are to turn off the automatic calculation, and to take use of Excel's "Special Cells Code" like below:

If your cells really are blank (no formulae or anything) something like faster1() could be good:

Sub faster1()
Application.ScreenUpdating = False
ActiveCell.Select
Selection.Resize(Selection.Rows.Count + 15500, _
Selection.Columns.Count).Select
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = True
End Sub

If you have formulae, you may want to try the following:

Sub faster2()
Application.ScreenUpdating = False
With Application
.Calculation = xlManual
End With
ActiveCell.Select
Selection.Resize(Selection.Rows.Count + 15500, _
Selection.Columns.Count).Select
For Each cell In Selection
If cell.Value = "" Then
cell.ClearContents
End If
Next cell
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
With Application
.Calculation = xlAutomatic
End With
Application.ScreenUpdating = True
End Sub


HTH. Cheers, Nate
This message was edited by NateO on 2002-02-28 09:10

 

[Casey]

Thank you so very much that worked great it took about 7 secs vs 10 min before