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:

Sub DeleteBlankRows() 



    Dim Counter As Long 

    Dim i As Long 

    

    Counter = 15500 

    

    Application.ScreenUpdating = False 

    

    ' Loops through the desired number of rows.

    For i = Counter To 1 Step -1 

    

        ' Checks to see if the cell in the current row is blank.

        If Cells(i, 1) = "" Then 

            Cells(i, 1).EntireRow.Delete 

        End If 

    

    Next i 

    

    Application.ScreenUpdating = True 

End Sub 

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