Conditionally retain rows

[Guest]

I have a macro (thanks to this site) that deletes rows that do not meet
conditions. I now have reason retain rows that meet the conditions (delete
rows where the conditons are not met). For example, I want to delete all
rows where col2 <> any of up to 12 different branch numbers.
I tried changing the = to <> in the existing macro (which loops through for
each condition) but it seems the logic deletes the row because it does not
match condition 1, even if it would have matched a later condition. The row
is deleted by then.
Any ideas would be appreciated.
Thanks,
wal50

 

[Don Guillett]

As always, post your code for comments and suggestions.

 

[Guest]

Thanks for the quick response. As I said, a bit repetitive, but here you go:

'Delete Rows that do not match the list
Sub TrackingItemsWholesaleBeta()
Const strCriteria1 As String = "59"
Const strCriteria2 As String = "3100"
Const strCriteria3 As String = "3101"
Const strCriteria4 As String = "3102"
Const strCriteria5 As String = "3104"
Const strCriteria6 As String = "3117"
Const strCriteria7 As String = "3118"
Const strCriteria8 As String = "3121"
'Change to what is to be eliminated in above

Dim rngData As Range
Dim rngCell As Range
Dim rngDelete As Range

With Worksheets("Sheet1") '<<<<<Change to the Tab name
Set rngData = Intersect(.UsedRange, .Columns(2)) 'Change to the column
were the criteria is
End With

'One of the below sequences for each defined string
For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria1) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria2) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria3) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria4) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria5) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria6) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria7) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

For Each rngCell In rngData
If LCase(rngCell.Value) = LCase(strCriteria8) Then
If rngDelete Is Nothing Then
Set rngDelete = rngCell
Else: Set rngDelete = Union(rngDelete, rngCell)
End If
End If
Next rngCell

If Not rngDelete Is Nothing Then _
rngDelete.EntireRow.Delete

End Sub

 

[Guest]

Just to restate, I want to retain rows that match a different list.
BL

 

[Don Guillett]

Try this simpler idea and post back.

mystr = "59,3100,3101"
x = 3100'your value
If InStr(mystr, x) = 0 Then MsgBox "NO"

 

[Guest]

Thanks for the response. But I'm missing something. If I put your code into
a new module, I get a message box (No) when it runs.
FYI: The source info varies daily and may (or may not) have input from
1000+ departments (59, 3100, 31010, etc.), so it would be difficult to define
the total population. My VBA knowledge is limited, but if that the intent
of defining "mystr" it will be quite a list.
Of the 1000+, I want to retain 10-12 depts which will infrequently vary.
When the retain list changes, my plan was to modify the code for the new
numbers.
wal50

 

[Don Guillett]

As I understand it ,the idea is to have it do it for all BUT your list. Do
you want to delete the entire row where the value in the cell is NOT one of
the 10-12???

You may sent a workbook to the address below with a copy of this thread and
complete and clear instruction of what you want. I do not want to go back to
this to see what it was about and I do not want to guess what you want.