EXCEL VBA Vlookup multiple sheets-CodePudding

Please help a newbie, I just cannot work this out. getting confused.

I have a workbook with 2 worksheets.

Column A in both worksheets is a part number code.

Column B in both worksheets is the discount code for the part number in column A.

Column C in both worksheets is the part number supersession (new part number) column, however not all rows have a new part number in column C, some cells in column C are empty.

The new part number column C does not have any of their discount codes populated in column D.

My objective is to fill column D in both worksheets with the relevant discount codes found from Column B, but only for each cell in column C that is actually populated with a part number, looking in both worksheet1 and worksheet2.

worksheet1

worksheet2

So far I have had very little success with the following but i'm only scratching the surface and that believe that some VBA will be a better solution, but am getting very lost.

=XLOOKUP(D2,Sheet1!A:A & Sheet2!A:A,B:B,0,1)

This code was not a complete formula and was only very partially working.

Please help. Thank you.

CodePudding user response：

Use a Dictionary Object as the look-up table

Option Explicit

Sub macro1()

    Dim ws As Worksheet
    Dim lastrow As Long, i As Integer, r As Long
    Dim dict As Object, key, n As Long

    Set dict = CreateObject("Scripting.Dictionary")
    ' build look up from sheet 1 and 2
    For i = 1 To 2
        Set ws = Sheets(i)
        lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
        For r = 1 To lastrow
           key = Trim(ws.Cells(r, "A"))
           If dict.exists(key) Then
               MsgBox "Duplicate Part No '" & key & "'", vbCritical, "Row " & r
               Exit Sub
           Else
               dict.Add key, ws.Cells(r, "B")
           End If
        Next
    Next
   
    ' update col D on both sheets
    For i = 1 To 2
        Set ws = Sheets(i)
        lastrow = ws.Cells(Rows.Count, "C").End(xlUp).Row
        For r = 1 To lastrow
           key = Trim(ws.Cells(r, "C"))
           If Len(key) > 0 Then
               If dict.exists(key) Then
                    ws.Cells(r, "D") = dict(key)
                    n = n   1
                End If
            End If
        Next
    Next
    MsgBox n & " rows updated", vbInformation

End Sub