Find All Matches and copy side column's value <>""

Question

I have two sheets ("Clients", "Orders"). I want to match both by phone numbers.

In the Orders sheet I have the following table:

In the Clients sheet I have a list of Phones.

I am trying to loop to all the numbers in my Clients column, find a match in the Orders sheet that contains a mail in the side column value.

I am struggling with exiting the loop, since I don't change my variable "c", and it does not even find the mail, when it is not in the first row.

Dim wb As Workbook
Dim ws_clients As Worksheet
Dim ws_orders As Worksheet
Dim Lastrow As Long
Dim Phone_LookUp As Variant

Set wb = Application.ActiveWorkbook

Dim firstAddress As String
Dim finalrow As Long, i As Long
Dim shtCS As Worksheet, shtFD As Worksheet, rw As Range
Dim c As Range

Set shtCS = wb.Sheets("Clients")
Set shtFD = wb.Sheets("Orders")

finalrow = shtCS.Range("A" & Rows.Count).End(xlUp).Row

With shtFD.Columns(3)
    For i = 2 To finalRow
        Set c = .Find(shtCS.Cells(i, 13).Value)
        If Not c Is Nothing Then
            firstAddress = c.Address
            Do
                If c.Offset(0, 1).Value <> "" Then
                    shtCS.Cells(i, 22).Value = c.Offset(0, 1).Value
                    i = i + 1
                End If
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
    Next i
End With

Answer 1

Lookup Using Find

Microsoft

• Range.Find

Both examples on this page are at least unclear if not inaccurate or worse.

Above them, it states "The settings for LookIn, LookAt, SearchOrder, and MatchByte are saved each time you use this method." and then both examples do not contain the LookAt parameter xlPart (substrings). They also differ from your case in that they are changing (replacing) the value in the loop, so sooner or later there will be nothing left to find.

• Range.FindNext

Also, all three examples on this page are at least unclear if not inaccurate or worse.

• The first is the same as one of the two on the 'Find page'.
• In the second example, it is assumed that the LookAt parameter is xlPart (substrings). If it is also assumed that the LookIn parameter is xlValues which is necessary for the Find method to fail to find the value in a hidden row or column, the second part of the 'Loop While line' will always be true, making it redundant. On the other hand, if the LookIn parameter would be xlFormulas then the first part would always be true, making it redundant.
• In the third example, again it is assumed that the LookAt parameter is xlPart (substrings). It shows the benefit of the LookIn parameter xlFormulas being able to find in a hidden row or in this case, in a hidden column. The first part of the 'Loop While line' will always be true, making it redundant.

Your Case

• The following is how I would handle your case (using the Find method). Since I want to start the 'Find' from the first cell, I'm using the last cell of the range in the After argument (tricky). I'm using xlFormulas to be able to find even if rows or columns are hidden. Then I'm using xlWhole to find the whole string (not the substring). I omitted the parameters of the 'also important' arguments SearchOrder (not necessary when one row or one column), SearchDirection (xlNext by default), and MatchCase (False by default: A=a).
• Exit Do is used to exit the Do Loop when an email address has been found.
• Source (s) and Destination (d) is a concept I prefer to use in cases such as yours. Source is read from while Destination is written to. In 'Lookup' cases (like yours), the Destination is also read from. Feel free to change (rename) these e.g. to a 'Client and Order concept' if you feel it might be more readable for you.
• Adjust the values in the constants section.

The Code

Option Explicit

Sub lookupClientEmails()
    
    ' Source
    Const sName As String = "Orders"
    Const sFirstRow As Long = 2
    Const sLookup As String = "C" ' 3
    Const sResultOffset As Long = 1 ' referring to column 'D'
    ' Destination
    Const dName As String = "Clients"
    Const dFirstRow As Long = 2
    Const dLookup As String = "M" ' 13
    Const dResult As String = "V" ' 22
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ' Source
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    Dim sLastRow As Long
    sLastRow = sws.Cells(sws.Rows.Count, sLookup).End(xlUp).Row
    Dim srg As Range
    Set srg = sws.Cells(sFirstRow, sLookup).Resize(sLastRow - sFirstRow + 1)
    ' Destination
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    Dim dLastRow As Long
    dLastRow = dws.Cells(dws.Rows.Count, dLookup).End(xlUp).Row
    ' Variables
    Dim sCell As Range
    Dim i As Long
    Dim FirstAddress As String
    ' Loop
    For i = dFirstRow To dLastRow
        Set sCell = srg.Find(dws.Cells(i, dLookup).Value, _
            srg.Cells(srg.Rows.Count), xlFormulas, xlWhole)
        If Not sCell Is Nothing Then
            FirstAddress = sCell.Address
            Do
                If sCell.Offset(, sResultOffset).Value <> "" Then
                    dws.Cells(i, dResult).Value _
                        = sCell.Offset(, sResultOffset).Value
                    Exit Do
                End If
                Set sCell = srg.FindNext(sCell)
            Loop While sCell.Address <> FirstAddress
        End If
    Next i

End Sub

Answer 2

It was identified with the intention to change the email of the customer sheet according to the order details. Using a dictionary can reduce looping.

Sub test()

    Dim wb As Workbook
    Dim ws_clients As Worksheet
    Dim ws_orders As Worksheet
    Dim Lastrow As Long
    Dim Phone_LookUp As Variant
    
    Dim vDB As Variant, vR As Variant
    Dim vPhone As Variant
    Dim Dic As Object 'Dictionary
    Dim rngDB As Range
    Dim r As Long
    Dim s As String
    
    Set wb = Application.ActiveWorkbook
    Set Dic = CreateObject("Scripting.Dictionary") ' New Scripting.Dictionary

    Dim firstAddress As String
    Dim finalrow As Long, i As Long
    Dim shtCS As Worksheet, shtFD As Worksheet, rw As Range
    Dim c As Range

    Set shtCS = wb.Sheets("Clients")
    Set shtFD = wb.Sheets("Orders")

    finalrow = shtCS.Range("A" & Rows.Count).End(xlUp).Row
    With shtCS
         vDB = .Range("M1", "M" & finalrow) 'Phone number
         Set rngDB = .Range("v1", "v" & finalrow) 'email
         vR = rngDB
    End With
    For i = 1 To UBound(vDB, 1)
        Dic.Add vDB(i, 1), i
    Next i
    With shtFD
        vPhone = .Range("c1", "d" & .Range("c" & Rows.Count).End(xlUp).Row) 'phone, email
    End With
    r = UBound(vPhone, 1)
    For i = 1 To r
        If vPhone(i, 2) <> "" Then
            s = vPhone(i, 1)
            If Dic.Exists(s) Then
                vR(Dic(s), 1) = vPhone(i, 2)
            End If
        End If
    Next i
    rngDB = vR

End Sub