Delete Row Based on Cell Contents - excel

Question

I'm trying to check the contents of the cells in column Q and delete the rows that have a 0 in that column.
The macro should start checking in column Q at cell Q11 and stop when it encounters the cell containing the text "END". When finished it should select the cell at the upper left corner of the spreadsheet, which would normally be A1, but I have a merged cell there, so it's A1:K2.
Here are my two most recent versions of the macro:
'My second to last attempt
Sub DeleteRowMacro1()
Dim i As Integer
i = 11
Do
Cells(i, 17).Activate
If ActiveCell.Value = 0 Then
ActiveCell.EntireRow.Delete
End If
i = i + 1
Loop Until ActiveCell.Value = "END"
Range("A1:K2").Select
End Sub
'My last attempt
Sub DeleteRowMacro2()
Dim i As Integer
i = 11
GoTo Filter
Filter:
Cells(i, 17).Activate
If ActiveCell.Value = "END" Then GoTo EndingCondition
If ActiveCell.Value = "" Then GoTo KeepCondition
If ActiveCell.Value = 0 Then GoTo DeleteCondition
If ActiveCell.Value > 0 Then GoTo KeepCondition
EndingCondition:
Range("A1:K2").Select
KeepCondition:
i = i + 1
GoTo Filter
DeleteCondition:
ActiveCell.EntireRow.Delete
i = i + 1
GoTo Filter
End Sub
What DeleteRowMacro1() Does:
It leaves the row if there is text or a number greater than 0 in column Q, but it deletes the rows with cells with a 0 AND blank cells. I want to keep the rows with the blank cells.
This macro seems to be incapable of checking the 450 or so cells between the Q11 and the cell with "END" in one run. It only deletes about half of the rows it should each time. The first 10 or so rows are always done correctly, but then it appears to randomly choose rows with a zero or a blank in column Q to delete.
If I run the macro 7 or 8 times, it will eventually delete all of the rows with a 0 and the ones that are blank too. I would like it to completely do it's job in one run and not delete the rows with blank cells.
What DeleteRowMacro2() Does:
It never stops at "END".
I have to run it 7 or 8 times to completely get rid of all of the rows with a 0 in column Q. It also appears to randomly check cells for deletion (and once again besides the first 10 or so).
Because it never ends when I run it, the area of my screen where the spreadsheet is turns black and all I can see there is the green selected cell box flickering up and down at random locations in the Q column until it gets to a row number in the 32,000s. After that my screen returns to show the normal white spreadsheet and a box appears that says Run-time error '6': Overflow.
Please note: After I click "End" on the error box I can see that the macro worked as described above.

Answer 1

Try it as,
Option Explicit
Sub DeleteRowMacro3()
Dim rwend As Variant
With Worksheets("Sheet5")
If .AutoFilterMode Then .AutoFilterMode = False
rwend = Application.Match("end", .Range(.Cells(11, "Q"), .Cells(.Rows.Count, "Q")), 0)
If Not IsError(rwend) Then
With .Range(.Cells(10, "Q"), .Cells(rwend + 10, "Q"))
.AutoFilter Field:=1, Criteria1:=0, Operator:=xlOr, Criteria2:=vbNullString
With .Resize(.Rows.Count - 1, 1).Offset(1, 0)
If CBool(Application.Subtotal(103, .Cells)) Then
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End If
End With
End With
End If
.Activate
.Range("A1:K2").Select
If .AutoFilterMode Then .AutoFilterMode = False
End With
End Sub
I wasn't sure if you were looking specifically for zeroes or zero value so I included blank cells as well as numerical zeroes.

Answer 2

First, it's best practice to avoid using .Select/.Activate. That can cause some confusion and tricky writing when doing loops/macros in general.
Second, it's also best to avoid GoTo.
This macro will start at the last row in column Q, and make its way toward row 11. If the value of a cell is 0, it'll delete the row. If the value is END, it selects your range and exits the For loop, and then exits the sub.
Sub delRows()
Dim lastRow As Long, i As Long
Dim ws as Worksheet
Set ws = Worksheets("Sheet1") ' CHANGE THIS AS NECESSARY
lastRow = ws.Cells(ws.Rows.Count, 17).End(xlUp).Row
For i = lastRow To 11 Step -1
If ws.Cells(i, 17).Value = "END" Then
ws.Range("A1:K2").Select
Exit For
End If
If ws.Cells(i, 17).Value = 0 or ws.Cells(i, 17).Value = "0" Then
ws.Cells(i, 17).EntireRow.Delete
End If
Next i
End Sub

Answer 3

Try this variation of your first code:
Sub DeleteRowMacro1()
Dim i As Integer
i = 11
Do
Cells(i, 17).Activate
If IsEmpty(ActiveCell.Value) Then
ActiveCell.EntireRow.Delete
End If
If ActiveCell.Value = "END" Then
Exit Do
End If
i = i + 1
Loop
Range("A1:K2").Select
End Sub

Answer 4

Try this simpler, and faster version. It will locate all of the cells you want to delete, store them in a range object, and then delete them all at once at the end.
Public Sub DeleteRowsWithRange()
Dim rngLoop As Range
Dim rngMyRange As Range
For Each rngLoop In Columns("Q").Cells
If rngLoop.Value = "END" Then
Exit For
ElseIf rngLoop.Value = 0 Then
If rngMyRange Is Nothing Then
Set rngMyRange = rngLoop.EntireRow
Else
Set rngMyRange = Union(rngMyRange, rngLoop.EntireRow)
End If
End If
Next rngLoop
If Not rngMyRange Is Nothing Then rngMyRange.Delete xlShiftUp
Range("A1").Activate
Set rngLoop = Nothing
Set rngMyRange = Nothing
End Sub