For loop with "Find" function

Question

I have a dataset across two worksheets with approx. 59k rows in each.

I need to take a part number from sheet 1, defined as "wsBomb" and reference this against sheet 2, defined as "wsEam". Once you have this, there is an offset of 8 to get the supplier number and copy this back into "wsBomb".

I have this process working for the first piece of data. I am struggling to get this to work within a loop.

Edit
The findnextfunction has been implemented and is looping through and changing the part number as required. However, this is only referencing cell L2 and not incrementing:

Sub Macro1()
    
    Set wbTrying = Workbooks("RME EAM")
    Set wsBomb = wbTrying.Worksheets("Bomb")
    Set wsEam = wbTrying.Worksheets("EAM")
    
    rowCounterPartNumber = 2
    
    Set wf = Application.WorksheetFunction
    
    Set rng1 = wsBomb.Range("E" & rowCounterPartNumber)
    filterStr = wf.Transpose(rng1)
    
    Dim partNumber As Range
    Set partNumber = wsEam.Range("L:L").Find(What:=rng1.Value, LookIn:=xlValues, lookat:=xlWhole)
    Dim partNo
    
    For Each partNo In partNumber
        If Not partNo Is Nothing Then
            
            Do
                wsBomb.Range("D" & rowCounterPartNumber).Value = partNumber.Offset(, -8)
                rowCounterPartNumber = rowCounterPartNumber + 1
                Set partNumber = wsEam.Range("L2:L60000").FindNext(partNumber)
            
                If partNo Is Nothing Then
                    GoTo finished
                
                End If
            Loop While partNo <> ""
        End If
        
finished:
        
    Next
    
End Sub

Current output:
All part numbers are the same

The issue appears to be in the Set partNumber = wsEam.Range("L:L").Find(What:=rng1.Value, LookIn:=xlValues, lookat:=xlWhole) section, as the rowCounterPartNumber does not increment for column E or L.
I think is due to these being defined outside the loop.

You need to: first insert your worksheets into one array each, then index the second worksheets matches inside a dictionary. Lastly loop through the array for worksheet 1 checking if the value exists in de dictionary, if so, do your thing. — Damian, May 28 '19 at 09:54
Firstly, use `Option Explicit` in order to declare all variables. — Error 1004, May 28 '19 at 09:59
Your code doesn't fail to loop, it's just that your `partNumber` range is one single cell, so your loop only happens once. — Nacorid, May 28 '19 at 10:00
After the initial `Find`, look at using a `FindNext` to loop through your range and find each instance of your search criteria to operate on — Dave, May 28 '19 at 10:15
As per the [documentation](https://learn.microsoft.com/en-us/office/vba/api/excel.range.find) of the find function the return value is a _A Range object that represents the first cell where that information is found._ This means your `partNumber` range is a singular cell. — Nacorid, May 28 '19 at 10:20
Thank you @dave for providing me with "FindNext", this has enabled the macro to start looping, as per Edit2 above, however it is failing to increment correctly now against partNumber — Craig_kitch, May 28 '19 at 11:16
Could you read [mcve] and update your question with the revised code please? — SJR, May 28 '19 at 11:36
@SJR Thank you, i have now done this and only left in the final Edit — Craig_kitch, May 28 '19 at 12:49
Nacorid's comment still applies - `partNumber` is only a single cell. — SJR, May 28 '19 at 12:58
@SJR thank you for the update, could you please help me with defining this as a range rather than a single cell? — Craig_kitch, May 28 '19 at 13:03
Try looking at this question https://stackoverflow.com/questions/30380490/find-and-findnext-for-excel-vba Come back if you get stuck. — SJR, May 28 '19 at 13:10
This can help understanding how to find all matches on a sheet: https://stackoverflow.com/questions/55984796/find-and-set-as-variable-and-if/56001455#56001455 — AcsErno, May 28 '19 at 13:25

score 0 · Answer 1 · answered May 28 '19 at 14:19

Try this:

Sub Macro1()

Set wbTrying = Workbooks("RME EAM")
Set wsBomb = wbTrying.Worksheets("Bomb")
Set wsEam = wbTrying.Worksheets("EAM")

Dim s As String
rowCounterPartNumber = 2

Set wf = Application.WorksheetFunction

Set rng1 = wsBomb.Range("E" & rowCounterPartNumber)
filterStr = wf.Transpose(rng1)

Dim partNumber As Range
Set partNumber = wsEam.Range("L:L").Find(What:=rng1.Value, LookIn:=xlValues, lookat:=xlWhole)

If Not partNumber Is Nothing Then 'if found
    s = partNumber.Address        'store address of first found cell
    Do
        wsBomb.Range("D" & rowCounterPartNumber).Value = partNumber.Offset(, -8)
        rowCounterPartNumber = rowCounterPartNumber + 1
        Set partNumber = wsEam.Range("L:L").FindNext(partNumber)
    Loop Until partNumber.Address = s  'repeat until back to first found cell
End If

End Sub

For loop with "Find" function

1 Answers1