VBA excel to delete blank rows more than 8000 cell

delete_blank_rows_more_than_8000.vb

Sub del_COLA_empty()
    'D McRitchie http://www.mvps.org/dmcritchie/excel/delempty.htm 2004-01-10
    'based on  Matt Neuburg, PhD  http://www.tidbits.com/matt Aug 3, 1998
    'Loop required due to MS KB http://support.microsoft.com/?kbid=832293
    Dim i As Long
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual   'pre XL97 xlManual
    i = Cells.SpecialCells(xlCellTypeLastCell).Row
    For i = i To 1 Step -8000
      On Error Resume Next 'in case there are no blanks
      Range(Cells(Application.WorksheetFunction.Max(1, i - 7999), 1), _
         Cells(Application.WorksheetFunction.Max(i, 1), 1)). _
         SpecialCells(xlCellTypeBlanks).EntireRow.Delete
      On Error GoTo 0
    Next i
    Application.Calculation = xlCalculationAutomatic   'pre XL97 xlManual
    Application.ScreenUpdating = True
    ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
End Sub