Delete Rows

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.