Sunday, July 1, 2018

excel - 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?


Answer



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

No comments:

Post a Comment

plot explanation - Why did Peaches&#39; mom hang on the tree? - Movies &amp; TV

In the middle of the movie Ice Age: Continental Drift Peaches' mom asked Peaches to go to sleep. Then, she hung on the tree. This parti...