I'm trying to search a Table for multiple criteria and if I get multiple results for those criteria I want to display them.
Till now my code can search for multiple criteria but stops when it has found one result.
This is the code snippet: `
Set rngSearch = Sheets(Temp_Bereich).Range("A:M")
Set Found = rngSearch.Find(What:=Material_A, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Found Is Nothing Then
Firstfound = Found.Address
Do
If Found.EntireRow.Range("B1").Value = Material_B And _
Found.EntireRow.Range("C1").Value = Schmierzustand_AB And _
Found.EntireRow.Range("G1").Value = Rauheit_A And _
Found.EntireRow.Range("H1").Value = Rauheit_B And _
Found.EntireRow.Range("D1").Value = Schmiermittel_AB Then Exit Do 'Match found
Set Found = rngSearch.FindNext(After:=Found)
If Found.Address = Firstfound Then Set Found = Nothing
Loop Until Found Is Nothing
End If
If Not Found Is Nothing Then
Application.Goto Found.EntireRow
Haftreibwert.Value = Cells(Found.Row, 12).Value
Gleitreibwert.Value = Cells(Found.Row, 13).Value
Else
MsgBox "Es trifft leider nichts auf alle 6 Kriterien zu ", , "Kein Match gefunden"
End If
You haven't explained what you want to do with multiple results if found, but this should be a start:
Dim allA As Range, c As Range
Set rngSearch = Sheets(Temp_Bereich).Range("A:M")
'call a function to return all of the matches
Set allA = FindAll(rngSearch) 'really searching entire range, or just one column?
If allA.Count = 0 Then
MsgBox "Es trifft leider nichts auf alle 6 Kriterien zu ", , "Kein Match gefunden"
Exit Sub
End If
For Each c In allA
With c.EntireRow
If .Range("B1").Value = Material_B And _
.Range("C1").Value = Schmierzustand_AB And _
.Range("G1").Value = Rauheit_A And _
.Range("H1").Value = Rauheit_B And _
.Range("D1").Value = Schmiermittel_AB Then
Debug.Print "Matched on row# " & .Row
End If
End With
Next c
It's easier to manage the logic if you factor out the "find all matches" into a separate function.
'Find all exact matches for `val` in a supplied range and
' return as a collection of matched cells
Public Function FindAll(rng As Range, val As String) As Collection
Dim rv As New Collection, f As Range
Dim addr As String
Set f = rng.Find(what:=val, after:=rng.Cells(rng.Cells.Count), _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not f Is Nothing Then addr = f.Address()
Do Until f Is Nothing
rv.Add f
Set f = rng.FindNext(after:=f)
If f.Address() = addr Then Exit Do
Loop
Set FindAll = rv
End Function