Removing all the empty Rows at once

[mandukes]

Hi I need to remove all the empty rows, I have written this code but it removes 1 row at a time.

Sub RRow()

lastrow = Cells(Rows.count, "A").End(xlUp).Row
Dim rng As Range: Set rng = Application.Range("A1:A" & lastrow)
Dim cel As Range
For Each cel In rng.Cells
If cel.Value = "" Then cel.EntireRow.Delete
Next cel
End Sub

regards,

 

[Fluff]

If you blanks are truly blank, rather than formulae returning "" try

Sub DelonA()
   Range("A:A").SpecialCells(xlBlanks).EntireRow.Delete
End Sub

 

[mandukes]

Awesome! Thanks

 

[Fluff]

Glad to help & thanks for the feedback