Macro take 40 secound to run

Hi Charlene,

This code will delete those blank rows on your sheet. Set a breakpoint in it and step through it to see what it is doing.

Sub DeleteBlankRows()

    Dim RowAboveGrandTot As Double
    Dim LastRowOfData As Double
    
    RowAboveGrandTot = Cells(Rows.Count, "A").End(xlUp).Row - 1
    LastRowOfData = Cells(RowAboveGrandTot, "A").End(xlUp).Row + 1
    Rows(LastRowOfData & ":" & RowAboveGrandTot).Delete shift:=xlUp
    
End Sub