Find row with multiple search criteria on substrings in VBA - vba

Question

I need to find the row where a cell in column B contains two substrings.
For example these Strings in B1:B3
A string with Cows
Cows and stuff
A string with Chickens
I need to find the row B2where the 2 substrings Cows and shit are present.
What i tried so far:
Find formula that doesent do multiple search criteria. :(
=MATCH(1;INDEX((B:B="Cows")*(B:B="shit"););) that doesent do substrings
A lot other stuff i forgot,
If it is possible i would like a pure VBA solution.
Any ideas on this one?

Answer 1

http://www.mrexcel.com/forum/excel-questions/74933-matching-multiple-criteria-visual-basic-applications.html This is what you are looking for with your MATCH function.

Answer 2

The below will assign all values within column B to an array, and then assess each element of the array to see if it contains the strings "Cows" and "excrement".
To assess the string within the element, we use the InStr() Function.
Sub findStrings()
Dim wb As Workbook, ws As Worksheet
Dim arrValues() As Variant
Dim lrow As Long, i As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets(1)
lrow = ws.Cells(Rows.Count, 2).End(xlUp).Row
arrValues = Range(Cells(1, 2), Cells(lrow, 2))
For i = 1 To UBound(arrValues, 1)
If InStr(1, arrValues(i, 1), "Cows") Then
If InStr(1, arrValues(i, 1), "excrement") Then
MsgBox ("Cell " & Cells(i, 2).Address & " contains both strings.")
Exit Sub
End If
End If
Next i
End Sub
This will only find 1 match containing the strings you specify, if you require further matches then you will need a different solution.

Answer 3

This function returns range that contains all the cells having in its content both words given as parameters:
Public Function findCellsWithWords(firstWord As String, secondWord As String) As Excel.Range
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim rngFirst As Excel.Range
Dim rngSecond As Excel.Range
'--------------------------------------------------
Set wks = Excel.ActiveSheet
Set rng = wks.Columns(2).EntireColumn
Set rngFirst = findAll(rng, firstWord)
Set rngSecond = findAll(rng, secondWord)
Set findCellsWithWords = Excel.Intersect(rngFirst, rngSecond)
End Function
Public Function findAll(rng As Excel.Range, what As Variant) As Excel.Range
Dim rngResult As Excel.Range
Dim found As Excel.Range
Dim firstFound As String
'----------------------------------------------------------------------------
With rng
Set found = rng.Find(what)
Do Until found Is Nothing
If rngResult Is Nothing Then
firstFound = found.Address
Set rngResult = found
Else
Set rngResult = Excel.Union(rngResult, found)
End If
'Find next occurrence.
Set found = .FindNext(found)
If found.Address = firstFound Then Exit Do
Loop
End With
Set findAll = rngResult
End Function