VBA: Loop through columns and replace values according to cell value (two workbooks)

[vaemps]

I have two workbooks; one with data to be replaced (main workbook) and another where to find data to replace with (secondary workbook (converter) / two different sheets; product and subproduct).

In main workbook there is columns:

A: row_id = not to be touched
B: product_id = product code to be replaced
C: subproduct_id = sub product code to be replaced
D: subproduct_qty = not to be touched

In secondary workbook there are:

Sheet1: product
A: id = row id that I want to use as a replacement
B: product_id = matching with main workbook

Sheet2: subproduct
A: id = row id that I want to use as a replacement
B: subproduct_id = matching with main workbook

My aim is to loop through main workbook columns B and C and replace the value with a row_id from secondary workbook sheets product and subproduct. Here is my code:

Private Sub btn_convert_id_Click()

Dim LastRow1 As Long, LastRow2 As Long, DestLast1 As Long, DestLast2 As Long, CurRow As Long, DestRow As Long
Dim OpenFileName As String
Dim wbReplaceData As Workbook 'main workbook
Dim wbReplacementData As Workbook 'secondary workbook
Dim wsProduct As Worksheet 'replacement data / product (secondary sheet)
Dim wsSubproduct As Worksheet 'replacement data / subproduct (secondary sheet)
Dim wsReplaceData As Worksheet 'data to replace (main sheet)
    
Set wbReplacementData = ThisWorkbook
Set wsProduct = wbReplacementData.Sheets("product") 'secondary sheet (product)
Set wsSubproduct = wbReplacementData.Sheets("subproduct") 'secondary sheet (subproduct)
    
OpenFileName = Application.GetOpenFilename 'select and Open workbook
If OpenFileName = "False" Then Exit Sub
    
Set wbReplaceData = Workbooks.Open(OpenFileName, ReadOnly:=False) 'workbook where data needs to be replaced
Set wsReplaceData = wbReplaceData.Sheets("collectioninfo") 'sheet where data needs to be replaced
      
LastRow1 = wsProduct.Range("B" & Rows.Count).End(xlUp).Row
LastRow2 = wsSubproduct.Range("B" & Rows.Count).End(xlUp).Row
DestLast1 = wsReplaceData.Range("B" & Rows.Count).End(xlUp).Row
DestLast2 = wsReplaceData.Range("C" & Rows.Count).End(xlUp).Row
    
For CurRow = 2 To DestLast1 'assumes first row has headers
    If Not wsReplaceData.Range("B1:B" & DestLast1).Find(wsProduct.Range("B" & CurRow).Value, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
        DestRow = wsReplaceData.Range("B1:B" & DestLast1).Find(wsProduct.Range("B" & CurRow).Value, LookIn:=xlValues, LookAt:=xlWhole).Row
    End If
    wsReplaceData.Range("B" & DestRow).Value = wsProduct.Range("A" & CurRow).Value 'replace value in mainsheet Column B with secondary sheet (product) Column A value
Next CurRow
    
For CurRow = 2 To DestLast2 'assumes first row has headers
    If Not wsReplaceData.Range("C1:C" & DestLast2).Find(wsSubproduct.Range("B" & CurRow).Value, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then
        DestRow = wsReplaceData.Range("C1:C" & DestLast2).Find(wsSubproduct.Range("B" & CurRow).Value, LookIn:=xlValues, LookAt:=xlWhole).Row
    End If
    wsReplaceData.Range("C" & DestRow).Value = wsSubproduct.Range("A" & CurRow).Value 'replace value in mainsheet Column B with secondary sheet (subproduct) Column A value
Next CurRow

End Sub

In the main workbook column B, there are multiple cells with same product_id to match all subproduct_ids to one product. The problem is that now my macro replaces just one product_id with matching row_id and leaves others to be. How I can adjust the macro to replace every single instance of said product_id with matching row_id?

 

[vaemps]

I got it somewhat to work with "For i" addition, but it is not working properly. At some point it mixes up, and it doesn't replace all the values. It also replaces values wrong. Can someone spot what I am doing wrong?

Just to note, all data starts from row 2 as the row 1 is for headers.

Private Sub btn_convert_id_Click()
   
    Dim LastRow1 As Long, LastRow2 As Long, DestLast1 As Long, DestLast2 As Long, CurRow As Long, DestRow As Long, i As Long, j As Long
    Dim OpenFileName As String
    Dim wbReplaceData As Workbook 'main workbook
    Dim wbReplacementData As Workbook 'secondary workbook
    Dim wsProduct As Worksheet 'replacement data / product (secondary sheet)
    Dim wsSubproduct As Worksheet 'replacement data / subproduct (secondary sheet)
    Dim wsReplaceData As Worksheet 'data to replace (main sheet)
  
    Set wbReplacementData = ThisWorkbook
    Set wsProduct = wbReplacementData.Sheets("product") 'secondary sheet (product)
    Set wsSubproduct = wbReplacementData.Sheets("subproduct") 'secondary sheet (subproduct)
  
    OpenFileName = Application.GetOpenFilename 'select and Open workbook
    If OpenFileName = "False" Then Exit Sub
  
    Set wbReplaceData = Workbooks.Open(OpenFileName, ReadOnly:=False) 'workbook where data needs to be replaced
    Set wsReplaceData = wbReplaceData.Sheets("collectioninfo") 'sheet where data needs to be replaced
    
    LastRow1 = wsProduct.Range("B" & Rows.Count).End(xlUp).Row
    LastRow2 = wsSubproduct.Range("B" & Rows.Count).End(xlUp).Row
    DestLast1 = wsReplaceData.Range("B" & Rows.Count).End(xlUp).Row
    DestLast2 = wsReplaceData.Range("C" & Rows.Count).End(xlUp).Row
  
For i = 2 To DestLast1 'loop from row 2 to end in product_id column in main sheet
    For CurRow = 2 To LastRow2 'loop from row 2 to end in product_id column in secondary sheet
        If Not wsReplaceData.Range("B1:B" & DestLast1).Find(wsProduct.Range("B" & CurRow).Value) Is Nothing Then
            DestRow = wsReplaceData.Range("B1:B" & DestLast1).Find(wsProduct.Range("B" & CurRow).Value).Row
        End If
        wsReplaceData.Range("B" & DestRow).Value = wsProduct.Range("A" & CurRow).Value 'replace value in mainsheet Column B with secondary sheet (product) Column A value
    Next CurRow
Next

For j = 2 To DestLast2 'loop from row 2 to end in subproduct_id column in main sheet
    For CurRow = 2 To LastRow2 'loop from row 2 to end in subproduct_id column in secondary sheet
        If Not wsReplaceData.Range("C1:C" & DestLast2).Find(wsSubproduct.Range("B" & CurRow).Value) Is Nothing Then
            DestRow = wsReplaceData.Range("C1:C" & DestLast2).Find(wsSubproduct.Range("B" & CurRow).Value).Row
        End If
        wsReplaceData.Range("C" & DestRow).Value = wsSubproduct.Range("A" & CurRow).Value 'replace value in mainsheet Column B with secondary sheet (subproduct) Column A value
    Next CurRow
Next

End Sub

EDIT: script messes up at row 1834 in the product_id column.