This short script deletes rows IN A HURRY by leveraging Range.Autofilter

delete_rows_fast_with_autofilter.vb

Option Explicit
Public Sub DeleteRowsFastWithAutofilter()
    
    Dim wksData As Worksheet
    Dim rngDataBlock As Range
    Dim lngLastRow As Long, lngLastCol As Long
    
    'Set references up-front
    Set wksData = ThisWorkbook.Sheets("data")
    
    'Find the last row and last column then set the range
    With wksData
        lngLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByRows, _
                                 SearchDirection:=xlPrevious).Row
        lngLastCol = .Cells.Find(What:="*", LookIn:=xlFormulas, _
                                 SearchOrder:=xlByColumns, _
                                 SearchDirection:=xlPrevious).Column
        
        'Start from cell A1 (1, 1) and assign to the last row and last column
        Set rngDataBlock = .Range(.Cells(1, 1), .Cells(lngLastRow, lngLastCol))
    End With
    
    'Apply the Autofilter to the DataBlock range, deleting blank rows
    Application.DisplayAlerts = False
        With rngDataBlock
            .AutoFilter Field:=1, Criteria1:=vbNullString
            .Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Rows.Delete
        End With
    Application.DisplayAlerts = True
    
    'Turn off the Autofilter safely
    With wksData
        .AutoFilterMode = False
        If .FilterMode = True Then
            .ShowAllData
        End If
    End With
    
End Sub