Delete Rows

[EJensen]

I posted a similar post earlier this week, got an answer, and marked it as solved. Although the code is awesome its not working in all cases. Here is the code I have currently,

Sub DeleteRows()
Dim i As Long, LastRow As Long
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    For i = LastRow To 1 Step -1
If Cells(i, 1) <> "" Then
        If Cells(i, 6) >= 0 Then Rows(i).Delete
End If
    Next
End Sub

My goal is to get Sheet1 to look like Sheet2 on the attachment with this post. If you can think of a better way to do this please let me know.

This might give you an idea of what the macro is doing right now.

1. Scan Column A for contents. As soon as you find a row with contents look at the same row in Column F. If the value in Column F is greater than or equal to zero delete the row and continue deleting rows until Column A has contents in it again, and repeat the pattern for every row in Column A and Column F.

[shg]

Try this:

Sub DeleteRows()
    Dim iRow As Long
    Dim lRow As Long
    Dim rDel As Range
    
    iRow = 1
    lRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    
    Do
        Do While Len(Cells(iRow, 1).Text) = 0 And iRow <= lRow
            iRow = iRow + 1
        Loop
        
        If Cells(iRow, "F").Value >= 0 Then
            Do
                If rDel Is Nothing Then Set rDel = Rows(iRow)
                Set rDel = Union(rDel, Rows(iRow))
                iRow = iRow + 1
            Loop Until iRow > lRow Or Len(Cells(iRow, "A").Text) > 0
        Else
            iRow = iRow + 1
        End If
        If iRow > lRow Then Exit Do
    Loop
    
    If Not rDel Is Nothing Then rDel.Delete
End Sub

[EJensen]

This macro is great. There is one stubborn group of rows that has a zero in Column F and they won’t get deleted, even when I run the macro a second time. I’ve spent a lot of time looking at the row trying to figure out why it won’t get deleted but I can’t figure out why.

[shg]

Post an example that demonstrates.