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.
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.
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.