Hello MSDemocrat,
Sorry the reply took so long. I have been experiencing problems connecting with the forum. Have you had any problems?
Try this revised macro. It will let you interrupt it if you need to.
Sub DeleteEmptyRows()
Dim DelRows As Variant
Dim LastRow As Long
Dim r As Long
Dim n As Long
Application.ScreenUpdating = False
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
ReDim DelRows(1)
For r = LastRow To 1 Step -1
DoEvents
If Application.WorksheetFunction.CountA(Rows(r)) = 0 Then
n = n + 1
If IsEmpty(DelRows(0)) Then
DelRows(0) = r
DelRows(1) = r
Else
DelRows(1) = r
End If
Else
If Not IsEmpty(DelRows(0)) Then
Range(Rows(DelRows(0)), Rows(DelRows(1))).Delete
ReDim DelRows(1)
End If
End If
Next r
If Not IsEmpty(DelRows(0)) Then Range(Rows(DelRows(0)), Rows(DelRows(1))).Delete
Application.ScreenUpdating = True
MsgBox n & " Empty rows were deleted."
End Sub
Bookmarks