Code for deleting rows not working correctly

[Bagsy]

Hi I need a little help please
I have put some code together to delete an entire row if a cell in a list starting from B4 and is a variable length.
The code is sort of working but once it gets to a point where there are two or more blank cells in the list it is leaving some blank cells. I know I have got to get the code to step back on row but cannot get it to work.
Any help is much appreciated

Sub DeleteRows1()

If Sheets("Sheet1").Visible = xlSheetVisible Then

Sheets("Sheet1").Select

Dim myLstRng As Range
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
Set myLstRng = Sheets("Sheet1").Range("B4:B" & LastRow)

    For Each rng In myLstRng
        If rng = "" Then
         rng.EntireRow.Delete shift:=xlUp
    End If
  Next rng

Else
End If

    ActiveWorkbook.Save
End Sub

 

[Misca]

I believe the trick is to make your code work from the bottom to the top.

Try something like:

Sub DelRows()

Dim LastRow As Long
Dim cRow As Long


LastRow = Cells(Rows.Count, 2).End(xlUp).Row


For cRow = LastRow To 2 Step -1
    If Cells(cRow, 2) = "" Then
        Cells(cRow, 2).EntireRow.Delete shift:=xlUp
    End If
Next cRow


End Sub

 

[vcoolio]

Hello Bagsy,

Besides what Misca has advised, you may find that using autofilter is a more efficient method:-

Sub DeleteRows1()

With Sheet1.Range("B3", Sheet1.Range("B" & Sheet1.Rows.Count).End(xlUp)) '----> Assumes that there are headings in Row3.
        .AutoFilter 1, ""
        .Offset(1).EntireRow.Delete
        .AutoFilter
End With

End Sub

I hope that this helps.

Cheerio,
vcoolio.

 

[Bagsy]

Thanks Misca
How do I modify this code so it stops at range B4, as it is deleting rows above my list that I need

 

[Bagsy]

vcoolio.
That works great
many thanks

 

[vcoolio]

You're welcome Bagsy. I'm glad to have been able to help and thanks for the feed-back.

Cheerio,
vcoolio.