See if this will do
Option Explicit
Sub test()
MsgBox GetResults("VB", "Find 4")
MsgBox GetResults("VB", "Find 6")
MsgBox GetResults("BB", "Find 4")
MsgBox GetResults("VB", "Find 4")
MsgBox GetResults("BBq", "FindX 3")
End Sub
Function GetResults(Crit1 As String, Crit2 As String) As String
Dim Found As Range
Dim Found2 As Range
Dim WS As Worksheet
Dim f As Long
Set WS = ThisWorkbook.Worksheets("Sheet1")
With WS
Set Found = Find_All(Crit1, WS.Range("B2:B9"), , xlWhole)
If Found Is Nothing Then
GetResults = Crit1 & " - Not found"
Else
For f = 1 To Found.Count
Set Found2 = Find_All(Crit2, WS.Range("C2:C9"), , xlWhole)
If Found2 Is Nothing Then
GetResults = Crit1 & "-" & Crit2 & " - Not found"
Exit Function
Else
GetResults = Crit2
Exit Function
End If
Next f
End If
End With
End Function
Function Find_All(Find_Item As Variant, Search_Range As Range, _
Optional LookIn As XlFindLookIn = xlValues, _
Optional LookAt As XlLookAt = xlPart, _
Optional MatchCase As Boolean = False) As Range
Dim c As Range
Dim firstAddress As String
Set Find_All = Nothing
With Search_Range
Set c = .Find( _
what:=Find_Item, _
LookIn:=LookIn, _
LookAt:=LookAt, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=MatchCase, _
searchformat:=False) 'Delete this term for XL2000 and earlier
If Not c Is Nothing Then
Set Find_All = c
firstAddress = c.Address
Do
Set Find_All = Union(Find_All, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Function