vba - find multiple criteria

[Pepess]

Hi,

The program reads each row of Sheet 1, scans the three criteria we are looking for and it should find the entry in Sheet 2 that matches the criteria.
Criteria:
1) invoice number (location in Sheet 2: column D)
2) date of payment (location in Sheet 2: column B)
3) amount paid (location in Sheet 2: column E)

My code is currently working well to match the invoice number, however, it is ignoring the other two criteria and it returns the first entry found that matches invoice number even though date and/or amount paid are different.
Any ideas why the do...until loop is not working?

Thank you in advance.

Sub find_multiple_criteria()
    'Definition of variables for Sheet Sheet 1
    Dim LastRow As Long
    Dim RgNr As Range            'invoice number
    Dim rng As Range
    Dim ZD As Long               'date of payment
    Dim RgBe As Currency         'amount paid
    
    LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Range("C2:C" & LastRow)
    
    'Definition of variables to match invoices
    Dim Found As Range, FirstFound As String
    Dim rngSearch As Range
    
    'Iteration through visible rows only
    For Each RgNr In rng.SpecialCells(xlCellTypeVisible)
        MsgBox RgNr
        ZD = Cells(RgNr.Row, 6)
        RgBe = Cells(RgNr.Row, 5)
    
    
       'Matching the criteria
       Set rngSearch = Sheets("Sheet 2").Range("D:D")
       
       Set Found = rngSearch.Find(What:=RgNr, _
                                  LookIn:=xlValues, _
                                  LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, _
                                  searchdirection:=xlNext, _
                                  MatchCase:=False)
       
       If Not Found Is Nothing Then
       
           FirstFound = Found.Address
           
           Do
               If Found.EntireRow.Range("B1").Value = ZD And _
                  Found.EntireRow.Range("E1").Value = RgBe Then Exit Do
                  
               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
           matched = Sheets("Sheet 2").Cells(Found.Row, 4)
           Sheets("Sheet 1").Cells(RgNr.Row, 7).Value = matched
       Else
           MsgBox "Nothing matched all three criteria. ", , "No match found"
       End If
  
    Next RgNr
End Sub

 

[maabadi]

Please upload example data on sheet2 and what is criteria in sheet1 with XL2BB add-in (Preferable) OR
upload at free hosting site e.g. GoogleDrive, OneDrive, DropBox and Insert Link Here

 

[Pepess]

problem is solved

 

[maabadi]

Glad you can sort it and Thanks for follow-up.

 

[Peter_SSs]

Duplicate to: VBA Range.Find multiple criteria

In future, please do not post the same question multiple times. Per Forum Rules (#12), posts of a duplicate nature will be locked or deleted.

In relation to your question here, since your issue seems to be resolved, I have closed both threads.