CODEWITHSUNDEEP
vbaexcel
user7898186
user7898186

Reputation: 13

VBA loop through column to compare each cell with variable and delete the row if it doesn't match

I'm currently trying to create a loop that will look at column C starting from row 5 and compare each cell in that column until it reaches the last used cell in that column. Each cell would be checked against 8 variables to see if it matches. If the cell doesn't match any of variables the entire row must be deleted.

My current attempt looks like: 

Dim AC as long
Dim LastRow as long
AC=5
LastRow= Activesheet.range("A" & Rows.count).end(xlup).row
For AC = 5 To LastRow
            With Cells(AC, "C")
            Do Until Cells(AC, "C").Text = OC1 Or Cells(AC, "C").Text = OC2 Or Cells(AC, "C").Text = OC3 Or Cells(AC, "C").Text = OC4 Or Cells(AC, "C").Text = NC1 Or Cells(AC, "C").Text = NC2 Or Cells(AC, "C").Text = NC3 Or Cells(AC, "C").Text = NC4
                Rows(AC).EntireRow.Delete
            Loop
        End With
    Next AC

This should insure that once a row has been deleted the new row that took it's place (Ex. Deleting the entire row 5 would result in row 6 becoming row 5) So it should exit the Do Loop when there is a match, grab the next line number and repeat until there is another match. Only the code keeps throwing an execution interrupted error. Can someone please tell me what I'm doing wrong?

Upvotes: 1

Views: 1629

Answers (1)

YowE3K
YowE3K

Reputation: 23994

If your code is causing an infinite loop, and your error is only being generated when you try killing the infinite loop, you could use the following code:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim AC As Long
Dim LastRow As Long
AC = 5
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Do While AC <= LastRow
    If Cells(AC, "C").Text <> OC1 And _
       Cells(AC, "C").Text <> OC2 And _
       Cells(AC, "C").Text <> OC3 And _
       Cells(AC, "C").Text <> OC4 And _
       Cells(AC, "C").Text <> NC1 And _
       Cells(AC, "C").Text <> NC2 And _
       Cells(AC, "C").Text <> NC3 And _
       Cells(AC, "C").Text <> NC4 Then
        Rows(AC).Delete
        LastRow = LastRow - 1
    Else
        AC = AC + 1
    End If
Loop

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

The problem with the way you were currently doing things is that, once you got near LastRow (assuming you had deleted any earlier rows), you were looking at blank rows and therefore infinitely deleting them.

Or, of course, you could use the more generally accepted way of deleting rows - which is to start at the bottom and work upward:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim AC As Long
Dim LastRow As Long
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For AC = LastRow To 5 Step -1
    If Cells(AC, "C").Text <> OC1 And _
       Cells(AC, "C").Text <> OC2 And _
       Cells(AC, "C").Text <> OC3 And _
       Cells(AC, "C").Text <> OC4 And _
       Cells(AC, "C").Text <> NC1 And _
       Cells(AC, "C").Text <> NC2 And _
       Cells(AC, "C").Text <> NC3 And _
       Cells(AC, "C").Text <> NC4 Then
        Rows(AC).Delete
    End If
Next

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

Upvotes: 0

Related Questions