Add columns and lookup values in two different workbooks

Question

I have three workbooks, Workbook A, Workbook B and Workbook C.

To Workbook A, I want to add two columns at the end and call them "Item code" and "store code". The existing fields in Workbook A are "Item Descr" and "Store Descr".

To populate the field "Item code", I have to perform a lookup against Workbook B which has the columns "Item code" and "Item Descr".

To populate the "store code" column in Workbook A, I have to perform a lookup against Workbook C which has the columns "store code"and "store Descr".

This is my code so far:

Sub Macro1()

Dim LastRow As Long
Dim LastCol As Long
Dim iRow As Long
Set ws = Sheet1   ' NOTE: Change this if your data is not in Sheet1.

With ws
    LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

    .Cells(1, LastCol + 1).Value = "Brand_item"
    .Cells(1, LastCol + 2).Value = "Brand_code"
End With

Range("A2").Select
Selection.End(xlToRight).Select
Range("G2").Select
Windows("PE CLOSING OCT R2trial.xls").Activate
ActiveCell.FormulaR1C1 = _
    "=INDEX([PEcodez.xlsx]Sheet1!R1C2:R2338C2,MATCH(RC[-3], 
 [PEcodez.xlsx]Sheet1!R1C1:R2338C1,0))"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G2110")
Range("G2:G2110").Select
Range("G2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Range("G2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("H2").Select
Application.CutCopyMode = False
Windows("PE CLOSING OCT R2trial.xls").Activate
ActiveCell.FormulaR1C1 = _
    "=INDEX([PEdoorcodes.xlsx]Sheet1!R1C3:R29C3,MATCH(RC[-7],[PEdoorcodes.xlsx]Sheet1!R1C1:R29C1,0))"
Range("H2").Select
Selection.AutoFill Destination:=Range("H2:H2110")
Range("H2:H2110").Select
Range("H2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("H2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("H2").Select
Application.CutCopyMode = False

End Sub

How do I include the file path of the workbooks?

Update, I tried the following code to update my path:

ActiveCell.FormulaR1C1 = _
    "=INDEX(C:\Users\amy\Documents\amyTrial\[PEcodez.xlsx]Sheet1!$A:$A,MATCH(RC[-3],C:\Users\amy\Documents\amy\[PEcodez.xlsx]Sheet1!R1C1:R2338C1,0))"

It gives me

Application-defined or object-defined error.

What have you tried so far? Please add your code and specify where you get errors or stuck. If you didn't do anything yet I suggest to start with [recording a macro](https://support.office.com/en-us/article/automate-tasks-with-the-macro-recorder-974ef220-f716-4e01-b015-3ea70e64937b) and then improve that recorded code. • Reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) might be useful to improve your recorded macro. — Pᴇʜ, Oct 18 '18 at 06:54
So far I've only written the code below: Dim MyWorksheetLastColumn As Long Dim MyRowPointer As Long MyWorksheetLastColumn = MyWorksheet.Cells(1, Columns.Count).End(xlToLeft).Column MyWorksheet.Cells(1, MyWorksheetLastColumn + 1).Value = "Brand_item" MyWorksheet.Cells(1, MyWorksheetLastColumn + 2).Value = "Brand_store" — Darck28, Oct 18 '18 at 07:41
it only adds headers to the two new columns but doesnt add the columns — Darck28, Oct 18 '18 at 07:42
At first you should use [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) to get rid of all `.Select` and `.Activate` and specify a worksheet for all ranges. — Pᴇʜ, Oct 18 '18 at 08:22

score 0 · Answer 1 · answered Oct 21 '18 at 14:41

I have created some dummy workbooks/data on my end, as you did not provide screenshots.

For me, this is "Sheet1" in workbook A,

this is "Sheet1" in workbook B.

and this is "Sheet1" in workbook C.

I use the code below to look up item descriptions and store descriptions. You will need to change the file paths to workbook B and C in the code itself (provided you place the code itself in workbook A and run it from there).

Option Explicit

Private Sub lookupDescriptions()

    Dim pathToWorkbookB As String
    pathToWorkbookB = "C:\Users\User\Desktop\New folder\3 workbooks\B.xlsx" ' Change this to the real file path.

    Dim pathToWorkbookC As String
    pathToWorkbookC = "C:\Users\User\Desktop\New folder\3 workbooks\C.xlsx" ' Change this to the real file path.

    Dim workbookB As Workbook ' Contains: Item code, item descr
    Set workbookB = OpenWorkbook(pathToWorkbookB)
    If workbookB Is Nothing Then
        MsgBox ("Could not locate workbook B at the path below" & vbNewLine & vbNewLine & pathToWorkbookB & vbNewLine & vbNewLine & "Check file path provided. Code will stop running now.")
        Exit Sub
    End If

    Dim workbookC As Workbook ' Contains: Store code, store descr
    Set workbookC = OpenWorkbook(pathToWorkbookC)
    If workbookC Is Nothing Then
        MsgBox ("Could not locate workbook C at the path below" & vbNewLine & vbNewLine & pathToWorkbookC & vbNewLine & vbNewLine & "Check file path provided. Code will stop running now.")
        Exit Sub
    End If

    ' Workbooks A and B both contain "Item code",
    ' Get "Item description" from workbook B for each match
    With ThisWorkbook.Worksheets("Sheet1")
        Dim itemCodesInA As Range
        Set itemCodesInA = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)

        Dim storeCodesInA As Range
        Set storeCodesInA = .Range("B2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    End With

    With workbookB.Worksheets("Sheet1")
        Dim itemCodesInB As Range
        Set itemCodesInB = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)

        Dim itemDescriptionsInB As Range
        Set itemDescriptionsInB = .Range("B2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    End With

    ' Workbooks A and C both contain "Store code",
    ' Get "Store description" from workbook C for each match
    With workbookC.Worksheets("Sheet1")
        Dim storeCodesInC As Range
        Set storeCodesInC = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)

        Dim storeDescriptionsInC As Range
        Set storeDescriptionsInC = .Range("B2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    End With

    ' This is workbook A, change sheet name if necessary
    With ThisWorkbook.Worksheets("Sheet1")
        Dim lastRow As Long
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

        Dim lastColumn As Long
        lastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column

        .Cells(1, lastColumn + 1).Value2 = "Item description"
        With .Range(.Cells(2, lastColumn + 1), .Cells(lastRow, lastColumn + 1))
            .Formula = "=INDEX(" & itemDescriptionsInB.Address(True, True, xlA1, True) & ",MATCH(" & itemCodesInA(1).Address(False, True, xlA1, False) & "," & itemCodesInB.Address(True, True, xlA1, True) & ",0))"
            .Value2 = .Value2 ' Comment/delete this line to keep formulas
        End With

        .Cells(1, lastColumn + 2).Value2 = "Store description"
        With .Range(.Cells(2, lastColumn + 2), .Cells(lastRow, lastColumn + 2))
            .Formula = "=INDEX(" & storeDescriptionsInC.Address(True, True, xlA1, True) & ",MATCH(" & storeCodesInA(1).Address(False, True, xlA1, False) & "," & storeCodesInC.Address(True, True, xlA1, True) & ",0))"
            .Value2 = .Value2 ' Comment/delete this line to keep formulas
        End With
    End With

    ' Close workbooks without saving
    If Not (workbookB Is Nothing) Then workbookB.Close False
    If Not (workbookC Is Nothing) Then workbookC.Close False
End Sub

Private Function OpenWorkbook(ByVal fullPathToWorkbook As String) As Workbook
    If Len(Dir$(fullPathToWorkbook, vbNormal)) = 0 Then
        Exit Function
    End If

    Dim workbookName As String
    workbookName = VBA.Strings.Mid$(fullPathToWorkbook, VBA.Strings.InStrRev(fullPathToWorkbook, "\", -1, vbBinaryCompare) + 1)

    Dim outputWorkbook As Workbook

    On Error Resume Next
    Set outputWorkbook = Application.Workbooks(workbookName)
    On Error GoTo 0

    If outputWorkbook Is Nothing Then
        Set outputWorkbook = Application.Workbooks.Open(fullPathToWorkbook)
    End If

    Set OpenWorkbook = outputWorkbook
End Function

What I get in workbook A (after running the code above) is:

Owing to the differences between your workbooks and mine, it is unlikely that the code will work for you as is. You will likely need to change/tweak the code in certain places, if:

your sheets in workbook A, B, C are named something other than "Sheet1"
your data (including headers) has a different location/structure/layout
there are blanks/missing items (that would cause the lookup to fail)

Nonetheless, the code and accompanying screenshots may give you an idea on how to do it.

Sorry for the late reply; Thank you so much! I will try that out, much thanks :) — Darck28, Oct 29 '18 at 03:26
Thank you so much, it works just like I wanted it to :) I have another challenge now, I have another workbook, like workbook A in which I need to match the Store code to the Store description in Workbook C; the only problem is that in this new work book the Store code format is like this "ST01 Brady's Mall"; but I only want the first four characters of this string matched with the store code in Workbook C...is this possible? if there were a way to just compare the leftmost 4 characters with the store code in workbook C (which is 4 characters long) that would be fantastic! Thank you so much. — Darck28, Oct 29 '18 at 04:27

Add columns and lookup values in two different workbooks

1 Answers1