How to apply multiple criteria to .Find? - excel

Question

I adapted code I found online.
It finds the string "car" in column A and returns the rows as an array
It assigns a variable to the length of the array (how many matches it found)
It assigns a variable to generate a random number between 0 and the length of the array
It then prints a random matching row's value into K3
Dim myArray() As Variant
Dim x As Long, y As Long
Dim msg As String
With ActiveSheet.Range("A1:A" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row)
Set c = .find("Car", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
ReDim Preserve myArray(y)
myArray(y) = c.Row
y = y + 1
Set c = .findNext(c)
If c Is Nothing Then
GoTo DoneFinding
End If
Loop While c.Address <> firstAddress
End If
DoneFinding:
End With
For x = LBound(myArray) To UBound(myArray)
msg = msg & myArray(x) & " "
Next x
ArrayLen = UBound(myArray) - LBound(myArray)
random_index = WorksheetFunction.RandBetween(0, ArrayLen)
MsgBox myArray(random_index)
Dim test As String
test = "B" & myArray(random_index)
Range("K3").Value = Range(test)
Example
I'm struggling with adapting the find code to allow for multiple criteria. So in my example, it finds "Car". What if I want to find matches that had "Car" in column A and "Red" in column D?
I tried
With ActiveSheet.Range("A1:A" & "D1:D" & ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row & ActiveSheet.Range("D" & Rows.Count).End(xlUp).Row)
Set c = .find("Car", "Red", LookIn:=xlValues)
I get type mismatch on the Set line.
In case it is confusing, it currently looks for a string e.g. "Car" but I will eventually link this to the variable which will be assigned to a data validation list. So if the user chooses "car" from a drop down list, this is what it will search for.

Answer 1

Maybe Advancde Filter is something that fit your needs:
Example Code
Option Explicit
Public Sub FilterData()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("YourSheetName")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim CriteriaRange As Range
Set CriteriaRange = ws.Range("A1", "E2")
Dim DataRange As Range
Set DataRange = ws.Range("A4", "E" & LastRow)
DataRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=CriteriaRange, Unique:=False
End Sub
Public Sub ShowAll()
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
End Sub
Edit according comment:
You can use the advanced filter and then loop through the filter results:
Option Explicit
Public CurrentRow As Long
Public Sub FilterData()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("YourSheetName")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim CriteriaRange As Range
Set CriteriaRange = ws.Range("A1", "E2")
Dim DataRange As Range
Set DataRange = ws.Range("A4", "E" & LastRow)
DataRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=CriteriaRange, Unique:=False
End Sub
Public Sub ShowAll()
On Error Resume Next
ActiveSheet.ShowAllData
CurrentRow = 1
On Error GoTo 0
End Sub
Public Sub GetNextResult()
FilterData
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("YourSheetName")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim DataRange As Range
Set DataRange = ws.Range("A4", "E" & LastRow)
Dim FilteredData As Range
Set FilteredData = DataRange.Resize(ColumnSize:=1).SpecialCells(xlCellTypeVisible)
If CurrentRow + 1 > FilteredData.Cells.Count Then
CurrentRow = 1
End If
CurrentRow = CurrentRow + 1
Dim i As Long
Dim Cell As Variant
For Each Cell In FilteredData
i = i + 1
If i = CurrentRow Then
Cell.EntireRow.Select
'or
'MsgBox Cell.Value & vbCrLf & Cell.Offset(0, 1) & vbCrLf & Cell.Offset(0, 2) & vbCrLf & Cell.Offset(0, 3) & vbCrLf & Cell.Offset(0, 4)
End If
Next Cell
End Sub