如何遍历特定列中的单元格并根据其内容删除整行？

Question

This is another question where I feel like there's a simple answer, but I'm not finding it. I'm looping through each cell in column D and looking for specific dates (from the user input) and based on that cell's date and the dates in some corresponding cells, I'm changing the color of the row.

Instead of coloring the row, I'd like to be able to delete it.

Here's my code that currently colors those rows:

Range(Cells(2, 4), Cells(Rows.Count, 4).End(xlUp)).Select

Dim rCell, otherCell As Range
Dim TheAnswer$
Dim ConvertedDate#

TheAnswer = InputBox("In M/D/YY format, enter the first day of the month for which this report is being run." & _
                     vbCr & vbCr & "For example, you would enter ""12/1/2012"" for the December 2012 report.", "Enter Date M/D/YY")
ConvertedDate = CDate(TheAnswer)

For Each rCell In Selection
    If rCell.Value <> "" Then
        If rCell.Value And rCell.Offset(, 5) < ConvertedDate And rCell.Offset(, 5) <> "" Then rCell.EntireRow.Interior.Color = RGB(255, 102, 0)

        If rCell.Value < ConvertedDate And rCell.Offset(, 5) = "" Then

            If rCell.Offset(, 6) < ConvertedDate And rCell.Offset(, 6) <> "" Then rCell.EntireRow.Interior.Color = RGB(255, 102, 0)

            If rCell.Offset(, 7) < ConvertedDate And rCell.Offset(, 7) <> "" Then rCell.EntireRow.Interior.Color = RGB(255, 102, 0)

        End If

    End If
Next rCell

When I substitute rCell.EntireRow.Interior.Color = RGB(255, 102, 0) with rCell.EntireRow.Delete I get errors. If I step through the code I can see that it actually does delete the first row, but then errors out at the next line.

I obviously have multiple "If Then" statements, but if the first "If Then" condition is satisfied and the row is deleted, it should move on to the next cell. It seems to me that it's still trying to check that row that's been deleted. I'm definitely not an Excel VBA expert, but I'm thinking there should be something to add after the rCell.EntireRow.Delete piece that tells it to move to the next cell. I tried adding in Next rCell , but that errors out. Exit For just stops the macro altogether.

Answer 1

Mike, when you loop through range sets and delete rows, you need to loop backward from the last row because when you delete a row it doesn't exist anymore and it throughs Excel because that row is no longer in the loop range.

Try this:

Range(Cells(2, 4), Cells(Rows.Count, 4).End(xlUp)).Select

Dim rCell as Range, otherCell As Range
Dim TheAnswer$
Dim ConvertedDate#

TheAnswer = InputBox("In M/D/YY format, enter the first day of the month for which this report is being run." & _
                     vbCr & vbCr & "For example, you would enter ""12/1/2012"" for the December 2012 report.", "Enter Date M/D/YY")
ConvertedDate = CDate(TheAnswer)

Dim xrows as Long, i as Long
xrows = Selection.Rows.Count

For i = xrows to 1 Step -1

    Set rCell = Selection.Cells(i,1)

    If rCell.Value <> "" Then
        If rCell.Value And rCell.Offset(, 5) < ConvertedDate And rCell.Offset(, 5) <> "" Then rCell.EntireRow.Delete

        If rCell.Value < ConvertedDate And rCell.Offset(, 5) = "" Then

            If rCell.Offset(, 6) < ConvertedDate And rCell.Offset(, 6) <> "" Then rCell.EntireRow.Delete

            If rCell.Offset(, 7) < ConvertedDate And rCell.Offset(, 7) <> "" Then rCell.EntireRow.Delete

        End If

    End If

Next i

Not sure if you wanted all to be EntireRow.Delete , but you can easily switch it back.

Answer 2

See below, I updated and changed some duplicate conditions. The best two ways are either add the data into a variant array, process and then delete or as brettdj mentions in the comment add a flag, filter and then mass delete. I prefer the below as it scales well and is good practise to know for other data manipulation. Not tested as no template to base it on. See below:

Dim data() As Variant
Dim i As Double
Dim deleteRows As Range
Dim sht As Worksheet

Dim theAnswer As String
Dim ConvertedDate As Date

Set sht = Sheet1

theAnswer = InputBox("In M/D/YY format, enter the first day of the month for which this report is being run." & _
                 vbCr & vbCr & "For example, you would enter ""12/1/2012"" for the December 2012 report.", "Enter Date M/D/YY")
ConvertedDate = CDate(theAnswer)

data = sht.Range(Cells(2, 4), Cells(Rows.Count, 4).End(xlUp)).Resize(, 8)

    For i = 1 To UBound(data, 1)

        If (data(i, 1) <> vbNullString) Then

            If data(i, 1) <> vbNullString And data(i, 6) < ConvertedDate And data(i, 6) <> vbNullString Then

                If (deleteRows Is Nothing) Then
                    Set deleteRows = sht.Rows(i + 1)
                Else
                    Set deleteRows = Union(deleteRows, sht.Rows(i + 1))
                End If

            ElseIf data(i, 1) < ConvertedDate And data(i, 7) <> vbNullString And data(i, 8) <> vbNullString Then

                If data(i, 7) < ConvertedDate Or data(i, 8) < ConvertedDate Then

                    If (deleteRows Is Nothing) Then
                        Set deleteRows = sht.Rows(i + 1)
                    Else
                        Set deleteRows = Union(deleteRows, sht.Rows(i + 1))
                    End If

                End If

            End If

        End If

    Next i

deleteRows.Delete Shift:=xlUp