VBA For Each Loop Deleting Rows

[beartooth91]

I'm pretty sure this is a simple oversight, but I can't seem to figure it out:
I have a worksheet with data from B11:BO and to about row 100 (though it varies)
The code below is supposed to loop through and delete rows with the highlighted B cell color.
It kind of works....meaning when I run it; it deletes some of them and it takes me running the procedure another 3-4 times to get all of them.

Sub Delete_NA_Points()
'
'Define Variables----------------------------
Dim lr As Long, cell As Range
'--------------------------------------------


With Sheets(1)
  lr = .Cells(Rows.Count, "B").End(xlUp).Row
 
  For Each cell In .Range("B11:B" & lr)
    If cell.Interior.ColorIndex = 22 Then
      cell.EntireRow.Delete
    End If
  Next cell
End With
End Sub

 

[Joe4]

When you are deleting rows, you are changing the size of the range as you are trying to loop through it, which can cause rows to be missed.
Whenever deleting or inserting rows, you should always start from the bottom and work your way up, like this:

Sub Delete_NA_Points()
'
'Define Variables----------------------------
Dim lr As Long, r As Long
'--------------------------------------------


With Sheets(1)
  lr = .Cells(Rows.Count, "B").End(xlUp).Row
 
  For r = lr To 11 Step -1
    If Cells(r, "B").Interior.ColorIndex = 22 Then
      Rows(r).Delete
    End If
  Next r
End With
End Sub

 

[mumps]

When deleting rows, you have to start the loop at the bottom of the data and work upwards. Try

Sub Delete_NA_Points()
    Application.ScreenUpdating = False
    Dim lr As Long, x As Long
    With Sheets(1)
        lr = .Cells(Rows.Count, "B").End(xlUp).Row
        For x = lr To 11 Step -1
          If Range("B" & x).Interior.ColorIndex = 22 Then
            Rows(x).EntireRow.Delete
          End If
        Next x
    End With
    Application.ScreenUpdating = False
End Sub

 

[Joe4]

When deleting rows, you have to start the loop at the bottom of the data and work upwards. Try

Sub Delete_NA_Points()
    Application.ScreenUpdating = False
    Dim lr As Long, x As Long
    With Sheets(1)
        lr = .Cells(Rows.Count, "B").End(xlUp).Row
        For x = lr To 11 Step -1
          If Range("B" & x).Interior.ColorIndex = 22 Then
            Rows(x).EntireRow.Delete
          End If
        Next x
    End With
    Application.ScreenUpdating = False
End Sub

If referencing Rows instead of Cells, the "EntireRow" is redunant and unnecessary,

So this:

Rows(x).EntireRow.Delete

can just be simplified to this, like I did in my code:

Rows(x).Delete

 

[dmt32]

Hi
another approach you could consider that negates deleting each row one by one

Sub Delete_NA_Points()
    '
    'Define Variables----------------------------
    Dim lr          As Long
    Dim cell        As Range, DeleteRow As Range
    '--------------------------------------------
    Application.ScreenUpdating = False
    With Sheets(1)
        lr = .Cells(.Rows.Count, "B").End(xlUp).Row
        For Each cell In .Range("B11:B" & lr)
            If cell.Interior.ColorIndex = 22 Then
                If DeleteRow Is Nothing Then
                    Set DeleteRow = cell
                Else
                    Set DeleteRow = Union(cell, DeleteRow)
                End If
            End If
        Next cell
    End With
    'delete all matches in one go
    If Not DeleteRow Is Nothing Then DeleteRow.EntireRow.Delete
End Sub

Its a tad more code but may prove faster over a large range.

Hope helpful

Dave

 

[saboh12617]

Hello,

If you have a very long list, you might take advantage of using range.Autofilter with color criteria, to instantly delete all rows.

Sub Delete_NA_Points()

  Dim colRng As Range
  Set colRng = Sheets(1).Cells(11, "B")
 
  colRng.AutoFilter 1, 8421631, xlFilterCellColor
  Range(colRng, colRng.End(xlDown)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
 
  If Sheets(1).AutoFilterMode Then Sheets(1).ShowAllData
End Sub

"8421631" being the color code for ColorIndex = 22

 

[Joe4]

Though probably not as fast as some of the other excellent options presented here, one thing that would help to speed up the process using the loop method you first used would be to suppress calculations and sheet updating until all the deletions are completed, like this:

Sub Delete_NA_Points()
'
'Define Variables----------------------------
Dim lr As Long, r As Long
'--------------------------------------------

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

With Sheets(1)
  lr = .Cells(Rows.Count, "B").End(xlUp).Row
 
  For r = lr To 11 Step -1
    If Cells(r, "B").Interior.ColorIndex = 22 Then
      Rows(r).Delete
    End If
  Next r
End With

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

 

[beartooth91]

When you are deleting rows, you are changing the size of the range as you are trying to loop through it, which can cause rows to be missed.
Whenever deleting or inserting rows, you should always start from the bottom and work your way up, like this:

Sub Delete_NA_Points()
'
'Define Variables----------------------------
Dim lr As Long, r As Long
'--------------------------------------------


With Sheets(1)
  lr = .Cells(Rows.Count, "B").End(xlUp).Row
 
  For r = lr To 11 Step -1
    If Cells(r, "B").Interior.ColorIndex = 22 Then
      Rows(r).Delete
    End If
  Next r
End With
End Sub

This worked, Thanks!

 

[Joe4]

You are welcome.
Glad we were able to help.
Be sure to take a look at some of the other methods, some really good stuff there!