Find values in a for each loop using .Find()

Question

I am looking for a loop that copies the value for every matching input value and not just stuck on the first it finds. So I input into a combox some id number which I want to be found in 2 workbooks (wb FC and CL1) and copy the value to its right and paste in another workbook. In FC that value will appear only once but in CL1 it can appear many times. The loop I tried stucks on coping it just for the first found value and I want it to copy it for every matched value.

Here is what I came up with:

Option Explicit


Private Sub CommandButton1_Click()

Dim txt As String, wart As String
Dim offset As Integer
Dim r As Range, c As Range, d As Range, e As Range


txt = txtCo.Text
offset = txtOffset.Text

Set r = Workbooks("FC.xlsx").Worksheets("Arkusz1").Range("A:A")
Set c = r.Find(txt, LookIn:=xlValues)

If c Is Nothing Then
    MsgBox "nieznaleziono"
    Exit Sub

End If

wart = c.offset(0, offset).Text
MsgBox wart

Set d = Worksheets("CL1").Range("B:B")
Set e = d.Find(txt, LookIn:=xlValues)
 
e.offset(0, 18) = wart

End Sub

Thanks

Answer 1

Use FindNext to Find Multiple Matches

• Note that the Find method has many more arguments e.g. LookAt (a whole or a partial match) which is crucial in your case. Also, the LookIn argument set to the parameter xlValues may fail to find a match if rows are hidden. Therefore the parameter xlFormulas is most often a safer choice.
• FindNext method

Option Explicit

Private Sub CommandButton1_Click()

    Dim txt As String, wart As String
    Dim offset As Long
    Dim r As Range, c As Range, d As Range, e As Range
    
    txt = txtCo.Text
    offset = txtOffset.Text
    
    Set r = Workbooks("FC.xlsx").Worksheets("Arkusz1").Range("A:A")
    Set c = r.Find(txt, LookIn:=xlValues)
    
    If c Is Nothing Then
        MsgBox "nieznaleziono"
        Exit Sub
    End If
    
    wart = c.offset(0, offset).Value
    MsgBox wart
    
    Set d = Worksheets("CL1").Range("B:B")
    Set e = d.Find(txt, LookIn:=xlValues)
     
    Dim FirstAddress As String
    If Not e Is Nothing Then
        FirstAddress = e.Address
        Do
            e.offset(0, 18) = wart
            Set e = d.FindNext(e)
        Loop Until e.Address = FirstAddress
    End If
    
End Sub