Loop through Column, looking for an array of values, If NOT found, delete entire row

[blbat]

So I tried to modify some good code from Joe4, but ran into some walls.

I'm trying to modify his working loop to cycle through Column "D", find the values in the array, and delete any rows that DON'T have those values.
(With the addition of a "wildcard" at the end of each value in the array)

Sub DeleteAllExcept()

    Dim lr As Long
    Dim arr
    Dim r As Long
    Dim i As Long
    Dim x As String
   
    Application.ScreenUpdating = False

'   Store all values you want to search for in an array
    arr = Array("CSE*", "CC0*", "OE0*", "JOB*")   'I added The "*" wildcard. which I know does not work in this line...
   
'   Find last row with data in column D
    lr = Cells(Rows.Count, "D").End(xlUp).Row
   
'   Loop through all rows from bottom to top
    For r = lr To 1 Step -1
'       Loop through each value in array and check for a match
        For i = LBound(arr) To UBound(arr)
'           Get value to look for
            x = arr(i)
'           Check for value
            If Left(Cells(r, "D"), Len(x)) = x Then  ' I need this line to be if NOT EQUAL to
'               If value found, delete row and exit inner for loop
                Rows(r).Delete
                Exit For
            End If
        Next i
    Next r

    Application.ScreenUpdating = True
   
    MsgBox "Macro complete!"

End Sub

any help would be appreciated!

 

[blbat]

On line:

For r = lr3 To 1 Step -1


receiving a Run-Time error "91"
Object variable or with block variable not set

r is dimmed as a long, and lr3 is dimmed as a long, so I don't understand the error

 

[Fluff]

Are you sure it's that line giving the error?

 

[blbat]

when i "run to cursor" it will run to line:

lr3 = .Cells(Rows.Count, "D").End(xlUp).Row

but when i put cursor on :

For r = lr3 To 1 Step -1

it throws the error

 

[Fluff]

If you run the code normally do you get an error? If so what is it & what line is highlighted when you click debug?

 

[blbat]

Fluff,

here's the code with all the Dim statements.

I'm not sure what's going on with my Machine, because it's not giving me a "debug" option, just "OK" or "Help"

even "stepping into" the code it stops on that line though.

Sub Copy_Columns()

Dim Pos As Long
Dim vHeader As Variant
Dim rngFoundA As Range, rngFoundB As Range
Dim ArryHeaderA() As String, ArryHeaderB() As String
Dim wsA As Worksheet, wsB As Worksheet
Dim LastRowwsA As Long
Dim LastColA As Long
Dim LastRowwsB As Long
Dim LastColB As Long
Dim lr As Long, lr2 As Long, lr3 As Long
Dim MyArray As Variant
Dim arr
Dim r As Long
Dim i As Long
Dim x As String

Application.ScreenUpdating = False



'*****************Find work centers, delete those that are not wanted*********

With wsA
 ' ''wsA" dimmed as worksheet in Active Workbook

'   Store all values you want to search for in an array
    arr = Array("CSE", "CC0", "OE0")
    Dim Dic As Object
    Set Dic = CreateObject("scripting.dictionary")
    
         Dic.CompareMode = 1
         For i = LBound(arr) To UBound(arr)
            Dic.Add arr(i), Nothing
         Next i
   '         Find last row with data in column D
         lr3 = .Cells(Rows.Count, "D").End(xlUp).Row
   
   '         Loop through all rows from bottom to top
          For r = lr3 To 1 Step -1
   '            Check for value
             If Not Dic.Exists(Left(.Cells(r, "D"), 3)) Then
   '                If value not found, delete row and exit inner for loop
                 .Rows(r).Delete
             End If
          Next r
    
End With

'***************** END Find work centers, delete those that are not wanted*********
End Sub
[/CODE}

 

[Fluff]

You haven't assigned a sheet to the wsA variable

 

[blbat]

LOL @ Myself!

During a re-write, I left it BELOW the lines above... Thanks Fluff, I needed a second set of eyes to see what should have been plain to me.

I will go move some lines around and report back later today!

 

[Fluff]

Ok,

 

[blbat]

Fluff, amazing what assigning a value to a variable will do for my code! Thanks for sticking with me, it now works a charm. I will mark this question as "solved".

 

[Fluff]

Glad it's sorted & thanks for the feedback.