Error deleting discontinuous entire rows

Question

I have the following code which looks down column M to find empty cells. Each time an empty cell is found, then the entire row is deleted.

The code always leaves one row undeleted.

Can someone help to identify what is wrong with the code? I suspect that in deleting a row, the cell count goes wrong.

Private Sub CreateInvoice_Click()

Dim LastRow As Long
Dim cl As Range, rng As Range

With Sheet4
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

Set rng = Sheet4.Range("M1:M" & LastRow)

For Each cl In rng
If IsEmpty(cl) Then
 cl.EntireRow.Select ' MsgBox .Range("A" & cl.Row).Value & " has nothing in it"
End If
Next

End With

End Sub

Answer 1

I would use a filter as it's the fastest and most efficient way of deleting empty rows. Also the below doesn't use .Select method.

Sub RemoveEmpties()
    Dim ws As Worksheet
    Dim rng As Range
    Dim lastRow As Long

    Set ws = Sheet4

    lastRow = ws.Range("M" & ws.Rows.Count).End(xlUp).Row

    Set rng = ws.Range("M1:M" & lastRow)

    With rng
        .AutoFilter Field:=1, Criteria1:=""
        .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End With

    ws.AutoFilterMode = False
End Sub

Answer 2

Columns("M:M").Select

Selection.SpecialCells(xlCellTypeBlanks).Select      
Selection.EntireRow.Delete

Try using this