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

blbat

Active Member
Joined
Mar 24, 2010
Messages
318
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)
Code:
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

Active Member
Joined
Mar 24, 2010
Messages
318
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
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,202
Office Version
  1. 365
Platform
  1. Windows
Are you sure it's that line giving the error?
 

blbat

Active Member
Joined
Mar 24, 2010
Messages
318
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,202
Office Version
  1. 365
Platform
  1. Windows
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

Active Member
Joined
Mar 24, 2010
Messages
318

ADVERTISEMENT

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.

Code:
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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
58,202
Office Version
  1. 365
Platform
  1. Windows
You haven't assigned a sheet to the wsA variable
 

blbat

Active Member
Joined
Mar 24, 2010
Messages
318

ADVERTISEMENT

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!
 

blbat

Active Member
Joined
Mar 24, 2010
Messages
318
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".
 

Watch MrExcel Video

Forum statistics

Threads
1,132,792
Messages
5,655,332
Members
418,190
Latest member
Timex

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top