Search code examples
excelvbavlookupworksheetxlookup

EXCEL VBA Vlookup multiple sheets


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.


Solution

  • 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