Delete Row Based on Cell Contents

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 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

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 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 4

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