Delete colored rows but somehow it leaves some rows undeleted.

[feni1388]

Hello everyone.

I'm using below code to delete the colored rows (red).
The part that I don't understand is that it always leave a few rows undeleted.
Is it because the source row changes?
If someone can help me fix it, I'd really appreciate it.

PS: the rows is colored manually.

Sub DeleteRedRows()

Dim sourceSheet As Worksheet
Dim sourceRow As Range





' Set the source and target sheets

Set sourceSheet = ThisWorkbook.Worksheets("NextPO") ' Replace "Sheet1" with the actual name of your source sheet




' Loop through each row in the source sheet

For Each sourceRow In sourceSheet.UsedRange.Rows

' Check if the background color of the row is red (RGB value: 65535)

If sourceRow.Interior.Color = RGB(255, 0, 0) Then sourceRow.EntireRow.Delete






 Next sourceRow



MsgBox "Red rows has been deleted !"

End Sub

 

[myall_blues]

It does this because the code is deleting from the top down. Every time a row (sourcerow) gets deleted, they all shuffle up one, but the new row that replaces the deleted one has already been 'processed' so it gets left behind.
If you make a block of 10 red rows and look carefully you will find that each time the code runs it deletes half of those red rows.

To overcome this you need to delete from the bottom up.

Sub DeleteRedRows()
    Dim sourceSheet As Worksheet
    Dim sourceRow As Range
    Dim lastrow As Long, i As Long
    '
    ' Set the source sheet
    '
    Set sourceSheet = ThisWorkbook.Worksheets("Sheet3") ' Replace "Sheet3" with the actual name of your source sheet
    ActiveSheet.UsedRange 'Refresh UsedRange
    lastrow = sourceSheet.UsedRange.Rows(sourceSheet.UsedRange.Rows.Count).Row
    ' Loop through each row in the source sheet
    For i = lastrow To 1 Step -1  ' Delete from the bottom up.
    ' Check if the background color of the row is red (RGB value: 65535)
        If Rows(i).EntireRow.Interior.Color = RGB(255, 0, 0) Then
            Rows(i).EntireRow.Delete
        End If
    Next i
    MsgBox "Red rows has been deleted !"
End Sub

 

[feni1388]

It does this because the code is deleting from the top down. Every time a row (sourcerow) gets deleted, they all shuffle up one, but the new row that replaces the deleted one has already been 'processed' so it gets left behind.
If you make a block of 10 red rows and look carefully you will find that each time the code runs it deletes half of those red rows.

To overcome this you need to delete from the bottom up.

Sub DeleteRedRows()
    Dim sourceSheet As Worksheet
    Dim sourceRow As Range
    Dim lastrow As Long, i As Long
    '
    ' Set the source sheet
    '
    Set sourceSheet = ThisWorkbook.Worksheets("Sheet3") ' Replace "Sheet3" with the actual name of your source sheet
    ActiveSheet.UsedRange 'Refresh UsedRange
    lastrow = sourceSheet.UsedRange.Rows(sourceSheet.UsedRange.Rows.Count).Row
    ' Loop through each row in the source sheet
    For i = lastrow To 1 Step -1  ' Delete from the bottom up.
    ' Check if the background color of the row is red (RGB value: 65535)
        If Rows(i).EntireRow.Interior.Color = RGB(255, 0, 0) Then
            Rows(i).EntireRow.Delete
        End If
    Next i
    MsgBox "Red rows has been deleted !"
End Sub

Yes, you're right. It always leaves half of the red rows.
Thank you for your explanation and the solution.
I tried it and it works perfectly.