How to find multiple strings in VBA - vba

Question

Assume an Excel sheet contains the following values in a random column:
VARIABLE X
AbbA
AddA
bbAA
ccbb
KaaC
cccc
ddbb
ccdd
BBaa
ddbB
Bbaa
dbbd
kdep
mCca
mblp
ktxy
Now the column should be searched for several words and word-phrases at the same time, for example the following:
(1) "bb"
(2) "cc"
(3) "d"
I put the target strings in an array:
Dim searchFor As String
Dim xArr
searchFor = "bb/cc/d"
xArr = Split(searchFor , "/")
Also assume it does not matter if "bb" is in small letters or big letters (not case sensitive in this case). For the other cases it is case sensitive.
At the end I would like to select the respective target cases in terms of their associated rows. Please also note that I would like to include cases in the selection, where the target string (e.g. "bb") is part of a word (e.g. "dbbd").
If possible, ignore the column title ("VARIABLE X) for searching/filtering as well as in the final selection of values.
How can this be done in VBA using (1) filters and/or using (2) regular loops? Which way would you recommend?

Answer 1

AbBa should be either selected or deleted. I am trying to ID 'wrong cases' by applying this routine.
Further to my comments, here is an example using .Find and .FindNext
My Assumptions
We are working with Col A in Sheets("Sheet1")
My Array is predefined. You can use your array.
In the below example, I am coloring the cells red. Change as applicable.
Sub Sample()
Dim MyAr(1 To 3) As String
Dim ws As Worksheet
Dim aCell As Range, bCell As Range
Dim i As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
MyAr(1) = "bb"
MyAr(2) = "cc"
MyAr(3) = "d"
With ws
'~~> Loop through the array
For i = LBound(MyAr) To UBound(MyAr)
Set aCell = .Columns(1).Find(What:=MyAr(i), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
Set bCell = aCell
aCell.Interior.ColorIndex = 3
Do
Set aCell = .Columns(1).FindNext(After:=aCell)
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
aCell.Interior.ColorIndex = 3
Else
Exit Do
End If
Loop
End If
Next
End With
End Sub

Answer 2

Start with your data in column A, this:
Sub qwerty()
Dim i As Long, N As Long
N = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To N
t = LCase(Cells(i, 1).Text)
If InStr(t, "bb") + InStr(t, "cc") + InStr(t, "d") = 0 Then
Cells(i, 1).EntireRow.Hidden = True
End If
Next i
End Sub
will hide the miscreants:
AutoFilter can be tough with more than two options.

Answer 3

One way to delete these would be to use the Advanced Filter. Of course, you don't need VBA for this, but using VBA:
Option Explicit
Sub FilterByStrings()
Dim rData As Range
Dim rFiltered As Range
Dim rCriteria As Range
Dim vStrings As Variant, critStrings() As Variant
Dim I As Long
vStrings = VBA.Array("bb", "cc", "d")
Set rData = Range("a1", Cells(Rows.Count, "A").End(xlUp))
Set rFiltered = Range("B1")
Set rCriteria = Range("c1")
'Add the wild cards and the column headers
ReDim critStrings(1 To 2, 1 To UBound(vStrings) + 1)
For I = 0 To UBound(vStrings)
critStrings(1, I + 1) = rData(1, 1)
critStrings(2, I + 1) = "<>*" & vStrings(I) & "*"
Next I
'criteria range
Set rCriteria = rCriteria.Resize(UBound(critStrings, 1), UBound(critStrings, 2))
rCriteria = critStrings
rData.AdvancedFilter Action:=xlFilterCopy, criteriarange:=rCriteria, copytorange:=rFiltered
rCriteria.EntireColumn.Clear
End Sub
If you want to return the cells that match those strings, you would set up the criteria range differently, removing the <> and having the criteria in a single column, rather than in adjacent rows.