Using "wildcards" in a vlist array to delete rows in Excel

Good Morning All,

I'm trying to setup a vba macro to delete all user IDs out of a spreadsheet that do not start with designated prefixes (e.g. US, A1, VM, etc). The below block of code was found on the Code Library and looks to be what I need but there is one problem: When I enter in UserID prefixes into the vlist fields, it treats them as absolute rather then a part of the string that I want to keep.

Is there a way to incorporate wildcards into a vlist?

Sub Example1()
Dim vList
Dim lLastRow As Long, lCounter As Long
Dim rngToCheck As Range, rngFound As Range, rngToDelete As Range

Application.ScreenUpdating = False

With Sheet1
lLastRow = Get_Last_Row(.Cells)

If lLastRow > 1 Then

vList = Array("US", "A1", "EG", "VM")

'we don't want to delete our header row
With .Range("A2:A" & lLastRow)

For lCounter = LBound(vList) To UBound(vList)

Set rngFound = .Find( _
what:=vList(lCounter), _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=True)

'check if we found a value we want to keep
If rngFound Is Nothing Then

'there are no cells to keep with this value
If rngToDelete Is Nothing Then Set rngToDelete = .Cells

Else

'if there are no cells with a different value then
'we will get an error
On Error Resume Next
If rngToDelete Is Nothing Then
Set rngToDelete = .ColumnDifferences(Comparison:=rngFound)

Else
Set rngToDelete = Intersect(rngToDelete, .ColumnDifferences(Comparison:=rngFound))
End If
On Error GoTo 0

End If

Next lCounter
End With

If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete

End If
End With

Application.ScreenUpdating = True
End Sub

Hi,

You can use

vList = Array("US*", "A1*", "EG*", "VM*")

but I've just spotted a small bug in that code library example which needs to be corrected.

I think I've corrected the bug. Please test on a backup workbook and let me know.

Sub Example1()
Dim vList
Dim lLastRow As Long, lCounter As Long
Dim rngToCheck As Range, rngFound As Range
Dim rngToDelete As Range, rngDifferences As Range
Dim blnFound As Boolean

Application.ScreenUpdating = False


With Sheet1
lLastRow = Get_Last_Row(.Cells)

'we don't want to delete our header row
Set rngToCheck = .Range("A2:A" & lLastRow)
End With

If lLastRow > 1 Then

With rngToCheck

vList = Array("US*", "A1*", "EG*", "VM*")

For lCounter = LBound(vList) To UBound(vList)

Set rngFound = .Find( _
what:=vList(lCounter), _
lookat:=xlWhole, _
searchorder:=xlByRows, _
searchdirection:=xlNext, _
MatchCase:=True)

'check if we found a value we want to keep
If Not rngFound Is Nothing Then

blnFound = True

'if there are no cells with a different value then
'we will get an error
On Error Resume Next
Set rngDifferences = .ColumnDifferences(Comparison:=rngFound)
On Error GoTo 0

If Not rngDifferences Is Nothing Then
If rngToDelete Is Nothing Then
Set rngToDelete = rngDifferences
Else
Set rngToDelete = Intersect(rngToDelete, rngDifferences)
End If
End If

End If

Next lCounter
End With

If rngToDelete Is Nothing Then
If Not blnFound Then rngToCheck.EntireRow.Delete
Else
rngToDelete.EntireRow.Delete
End If
End If

Application.ScreenUpdating = True
End Sub


Public Function Get_Last_Row(ByVal rngToCheck As Range) As Long

Dim rngLast As Range

Set rngLast = rngToCheck.Find(what:="*", searchorder:=xlByRows, searchdirection:=xlPrevious)

If rngLast Is Nothing Then
Get_Last_Row = rngToCheck.Row
Else
Get_Last_Row = rngLast.Row
End If

End Function

Note, if you want it to ignore blank cells then change the VList array to:

vList = Array("US*", "A1*", "EG*", "VM*", "")


It's not as clean as it could be, but at least it will get you on your way...
Once we're sure it's okay I'll improve it and amend the code library article.

Thank you for the quick reply Colin. The wild card did work, but it only selected the first record that met the qualification. So in my workbook of 30000 lines, it deleted everything except 4 - the first result for each vlist entry.

Hi

I amended a bug in the code - revised version in post #3. Please see if it works for you. If not, I'll have to look into it more. There are limitations with ColumnDifferences which could be causing an issue for you.

Same thing as before. Only selects the first result of each vlist entry. Displays only the header and 4 rows; everything else is deleted.

Ah, of course. I've fixed the bug but this procedure isn't appropriate for your problem because each entry starting with US* etc... will be considered to be different by ColumnDifferences. So your picking it out has helped the code library article but not your own project!

Which version of Excel are you using?

Argh!

Excel 2003

In XL 2003 the easiest way is to use the advanced filter.

The criteria range is straightforward enough:

Appropriate Header
US
A1
EG
VM

The header should match the relevant column in your table. Use the advanced filter to apply this criteria range and choose to a Copy To range to house the results. Then just clear the original table and copy the results back over.

Once you're happy the manual system works, putting together some VBA code to automate it should be quite quick.

Ok, the manual method using Advanced Filter does the trick. What is the quickest way to automate it? Macro recorder?

Sure, then we can tweak it to smarten it up a little. Here's the sort of thing I got:

Sub Macro1()

Dim rngToCheck As Range, rngCriteria As Range, rngDestination As Range

Set rngToCheck = Sheet1.Range("A:A")
Set rngCriteria = Sheet1.Range("F1:F5")
Set rngDestination = Sheet1.Range("O:O")


rngToCheck.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=rngCriteria, _
CopyToRange:=rngDestination, _
Unique:=False

rngToCheck.ClearContents
rngDestination.CurrentRegion.Cut rngToCheck.Cells(1)

End Sub