Reputation: 993
One of our customers sent me this huge excel file and one of my tasks is to build a macro that will clean up data in few sheets. Now, I found this excellent example
where one user is suggesting to use the Excel Find Method to speed up the process...which BTW is working perfectly.
BUT, in my case I want to keep the matching rows and delete rest of them. How can I do that in VBA? For example, where they are saying...
Set rFound = .Columns(1).Find(What:="Cat", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=...)
How can I set the value for WHAT to 'NOT'? I tried few different things like:
This might be a very silly question...but I just can't find the correct answer anywhere and feeling very frustrated :( Any helps will be greatly appreciated!!
Upvotes: 1
Views: 226
Reputation: 53623
Per my comment above, and also @TimWilliams' answer, I think AutoFilter
is probably the way to go with this.
I keep forgetting that Excel does not have a range Difference
method (the opposite of Intersect
, but that doesn't mean you can't use a similar logic with some UDF creativity.
Have a look at Chip Pearson's excellent FindAll
method. Normally, Excel's .Find
method only returns a single cell range (or Nothing
). This is not particularly useful for your problem, since it requires you to do a clunky iteration and FindNext
until you've exhausted the range.
Using the FindAll
method, returns a range of all matching cells. We can then iterate over the cells in your column, and test whether they intersect the range returned from the FindAll
method. If they do not intersect, then there is no match, so we can delete the row.
Sub TestFindAll()
Dim ws As Worksheet
Dim col As Range
Dim allFound As Range
Dim c As Long
Dim cl As Range
Set ws = ActiveSheet
Set col = Intersect(ws.Columns(1), ws.UsedRange)
Set allFound = FindAll(col, "Cat", xlValues, xlPart)
For c = col.Cells.Count To 1 Step -1
Set cl = col.Cells(c)
If Intersect(allFound, cl) Is Nothing Then
'cl.Interior.ColorIndex = 39 '## I use this line for debugging
cl.EntireRow.Delete
End If
Next
End Sub
'http://www.cpearson.com/excel/findall.aspx
Function FindAll(SearchRange As Range, _
FindWhat As Variant, _
Optional LookIn As XlFindLookIn = xlValues, _
Optional LookAt As XlLookAt = xlWhole, _
Optional SearchOrder As XlSearchOrder = xlByRows, _
Optional MatchCase As Boolean = False, _
Optional BeginsWith As String = vbNullString, _
Optional EndsWith As String = vbNullString, _
Optional BeginEndCompare As VbCompareMethod = vbTextCompare) As Range
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' FindAll
' This searches the range specified by SearchRange and returns a Range object
' that contains all the cells in which FindWhat was found. The search parameters to
' this function have the same meaning and effect as they do with the
' Range.Find method. If the value was not found, the function return Nothing. If
' BeginsWith is not an empty string, only those cells that begin with BeginWith
' are included in the result. If EndsWith is not an empty string, only those cells
' that end with EndsWith are included in the result. Note that if a cell contains
' a single word that matches either BeginsWith or EndsWith, it is included in the
' result. If BeginsWith or EndsWith is not an empty string, the LookAt parameter
' is automatically changed to xlPart. The tests for BeginsWith and EndsWith may be
' case-sensitive by setting BeginEndCompare to vbBinaryCompare. For case-insensitive
' comparisons, set BeginEndCompare to vbTextCompare. If this parameter is omitted,
' it defaults to vbTextCompare. The comparisons for BeginsWith and EndsWith are
' in an OR relationship. That is, if both BeginsWith and EndsWith are provided,
' a match if found if the text begins with BeginsWith OR the text ends with EndsWith.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FoundCell As Range
Dim FirstFound As Range
Dim LastCell As Range
Dim ResultRange As Range
Dim XLookAt As XlLookAt
Dim Include As Boolean
Dim CompMode As VbCompareMethod
Dim Area As Range
Dim MaxRow As Long
Dim MaxCol As Long
Dim BeginB As Boolean
Dim EndB As Boolean
CompMode = BeginEndCompare
If BeginsWith <> vbNullString Or EndsWith <> vbNullString Then
XLookAt = xlPart
Else
XLookAt = LookAt
End If
' this loop in Areas is to find the last cell
' of all the areas. That is, the cell whose row
' and column are greater than or equal to any cell
' in any Area.
For Each Area In SearchRange.Areas
With Area
If .Cells(.Cells.Count).Row > MaxRow Then
MaxRow = .Cells(.Cells.Count).Row
End If
If .Cells(.Cells.Count).Column > MaxCol Then
MaxCol = .Cells(.Cells.Count).Column
End If
End With
Next Area
Set LastCell = SearchRange.Worksheet.Cells(MaxRow, MaxCol)
On Error GoTo 0
Set FoundCell = SearchRange.Find(what:=FindWhat, _
after:=LastCell, _
LookIn:=LookIn, _
LookAt:=XLookAt, _
SearchOrder:=SearchOrder, _
MatchCase:=MatchCase)
If Not FoundCell Is Nothing Then
Set FirstFound = FoundCell
Do Until False ' Loop forever. We'll "Exit Do" when necessary.
Include = False
If BeginsWith = vbNullString And EndsWith = vbNullString Then
Include = True
Else
If BeginsWith <> vbNullString Then
If StrComp(Left(FoundCell.Text, Len(BeginsWith)), BeginsWith, BeginEndCompare) = 0 Then
Include = True
End If
End If
If EndsWith <> vbNullString Then
If StrComp(Right(FoundCell.Text, Len(EndsWith)), EndsWith, BeginEndCompare) = 0 Then
Include = True
End If
End If
End If
If Include = True Then
If ResultRange Is Nothing Then
Set ResultRange = FoundCell
Else
Set ResultRange = Application.Union(ResultRange, FoundCell)
End If
End If
Set FoundCell = SearchRange.FindNext(after:=FoundCell)
If (FoundCell Is Nothing) Then
Exit Do
End If
If (FoundCell.Address = FirstFound.Address) Then
Exit Do
End If
Loop
End If
Set FindAll = ResultRange
End Function
Upvotes: 2
Reputation: 166366
With ActiveSheet.Range(Range("A1"), Cells(Rows.Count, 1).End(xlUp))
.AutoFilter Field:=1, Criteria1:="<>cat"
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilter
End With
Upvotes: 2