Clear rows with an empty cell in column A, without deleting entire row takes a very long time

Question

This code is a part of a larger macro.

Sub testremoveBlankRows()

Dim rng8        As Range
Dim cell        As Range
'------------------------------
'Start Timer
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
'-------------------------------------------------
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
    .EnableEvents = False
    .CutCopyMode = False
End With
'--------------------------------------------------
ActiveSheet.UsedRange
On Error Resume Next
Set rng8 = Columns("A").SpecialCells(xlBlanks)
On Error GoTo 0

If rng8 Is Nothing Then Exit Sub
    For Each cell In rng8.Areas
        cell.Cells(1).Offset(0, 0).Resize(cell.Rows.count, 24).Delete xlUp
    Next cell
'-------------------------------------------------------------
With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .EnableEvents = True
    .CutCopyMode = False
End With
'-------------------------------------------------------------
'Stop Timer
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
'-------------------------------------
End Sub

This piece of code takes about 85 seconds to run (Sheet1), if I use it in the macro. If I run code separately (Sheet1), it still takes about 85 seconds to run. If I open a new Worksheet in original Workbook and copy/paste values, run code separately, it still takes about 85 seconds to run. If I open a new Workbook and copy/paste values from Sheet1, it takes 0,49 seconds!

What can I do to have it run in 0,49 seconds in the original Workbook?

Answer 1

I would sort on col A and the delete all the rows at once.
Otherwise, if you need to keep the current logic I would turn calculation to Manual during that part Application.Calculation = xlManual (since you mentioned that it takes only 1/2 sec when you copy/paste values in a blank workbook).
And I would rewrite

cell.Cells(1).Offset(0, 0).Resize(cell.Rows.count, 24).Delete xlUp

as

cell.Resize(1, 24).Delete xlUp  

or perhaps

cell.EntireRow.delete