Excel VBA deleting rows in a for loop misses rows
I have a subroutine that deletes rows in a range containing around 1000 rows. Rows are deleted on a critera. The code below works.
However, when I run the macro I usually have to run it 4 times before all rows containing the removal criteria are removed.
I guess this is because the for loop misses its index when a row suddenly dissapears when deleting a row.
My first code looks like this.
Set StatusRange = Range("B2", Range("B2").End(xlDown))
For Each StatusCell In StatusRange
If StatusCell = "FG" Then
StatusCell.EntireRow.Delete
ElseIf StatusCell = "QC" Then
StatusCell.EntireRow.Delete
ElseIf StatusCell = "CS" Then
StatusCell.EntireRow.Delete
Else
End If
Next StatusCell
When I try to update the range each loop, it still doesn't work.
Set StatusRange = Range("B2", Range("B2").End(xlDown))
For Each StatusCell In StatusRange
If StatusCell = "FG" Then
StatusCell.EntireRow.Delete
ElseIf StatusCell = "QC" Then
StatusCell.EntireRow.Delete
ElseIf StatusCell = "CS" Then
StatusCell.EntireRow.Delete
Else
End If
Set StatusRange = Range("B2", Range("B2").End(xlDown))
Next StatusCell
Is there anyone who know a sloution to this?
Work from the bottom up. If you delete a row, everything moves up and you skip that row on the next iteration.
Here is the 'guts' of the code to work up from the bottom.
With Worksheets("Sheet1")
For rw = .Cells(.Rows.Count, "B").End(xlUp).Row To 2 Step -1
Select Case UCase(.Cells(rw, "B").Value2)
Case "FG", "QC", "CS"
.Rows(rw).EntireRow.Delete
End Select
Next rw
End With
Since there's no Reverse loop for For Each
you need to use a slightly different approach.
Also, your code with multiple If
s and OR
is "screaming for the use of Select Case
.
Dim StatusRange As Range
Dim i As Long
Set StatusRange = Range("B2", Range("B2").End(xlDown))
' loop backward when deleting Ranges, Rows, Cells
For i = StatusRange.Rows.Count To 1 Step -1
Select Case StatusRange(i, 1).Value
Case "FG", "QC", "CS"
StatusRange(i, 1).EntireRow.Delete
Case Else ' for the future if you need it
End Select
Next i
Wait til the For Each
loops ends before deleting the rows:
Option Explicit
Sub mySub()
Dim myRange As Range
Set myRange = ActiveSheet.UsedRange
Dim myCell As Range
Dim myTrash As Range
For Each myCell In myRange
Select Case myCell.Value
Case "my value"
If myTrash Is Nothing _
Then
Set myTrash = myCell.EntireRow
Else
Set myTrash = Union(myTrash, myCell.EntireRow)
End If
End Select
Next
If Not myTrash Is Nothing Then myTrash.Delete
End Sub