There was an old thread I was involved in regarding the use of the Union
function for this type of operation. It was decided back then (as I recall)
that if there were lots (hundreds?) of disjointed areas involved in the
Union, that the code would become slower and slower as the union of
disjointed areas grew. Given the OP has 60,000 rows to process, the odds are
great of there being more than 100 disjointed areas involved The solution
was to do whatever operation was to be done to the union (in this case,
Delete) every 100 unions or so. Here is your code, modified to do this, (and
I also turned off the screen updating and calculations during the process to
help speed thing up a little more), this code should pretty much be the
fastest way to do the requested delete operation...
Sub macro_der()
Dim i As Long, nLastRow As Long, r As Range
Dim OriginalCalculationMode As Long
On Error GoTo Whoops
OriginalCalculationMode = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Set r = ActiveSheet.UsedRange
nLastRow = r.Rows.Count + r.Row - 1
Set r = Rows(nLastRow + 1)
For i = nLastRow To 1 Step -1
If Application.CountA(Rows(i)) = 0 Then
Set r = Union(r, Rows(i))
If r.Areas.Count > 100 Then
r.Delete
Set r = Rows(nLastRow + 1)
End If
End If
Next
If Not r Is Nothing Then r.Delete
Whoops:
Application.Calculation = OriginalCalculationMode
Application.ScreenUpdating = True
End Sub