VBA coding to Vlookup from multiple workbooks

[christomunthe]

Hi,
I have a question regarding how to create a VBA coding to Vlookup from multiple workbooks. However, if there is no value in the Vlookup, the destination column does not change into "N/A". Hence, I want it to keep it as it is.

Here's the coding that I have made:
Sub VLookupFromMultipleSources()

Dim SourceFile As Variant
Dim LookupValue As Variant
Dim WorkbookSource1 As Workbook
Dim WorkbookSource2 As Workbook
Dim WorkbookSource3 As Workbook
Dim LookupRange1 As Range
Dim LookupRange2 As Range
Dim LookupRange3 As Range
Dim DestinationRange As Range
Dim FoundValue1 As Variant
Dim FoundValue2 As Variant
Dim FoundValue3 As Variant

'Set the lookup value to the current cell
LookupValue = ThisWorkbook.Worksheets("LOG").Range("E:E")

'Define the lookup range in the source files
Set WorkbookSource1 = Workbooks.Open(ThisWorkbook.Path & "\Template Tracker PR AML BB1.xlsx")
Set LookupRange1 = WorkbookSource1.Worksheets("Tracker").Range("D3:H200")

Set WorkbookSource2 = Workbooks.Open(ThisWorkbook.Path & "\Template Tracker PR AML BB2.xlsx")
Set LookupRange2 = WorkbookSource2.Worksheets("Tracker").Range("D3:H200")

Set WorkbookSource3 = Workbooks.Open(ThisWorkbook.Path & "\Template Tracker PR AML BB3.xlsx")
Set LookupRange3 = WorkbookSource3.Worksheets("Tracker").Range("D3:H200")

'Set Destination Range
Set DestinationRange = ThisWorkbook.Worksheets("LOG").Range("AL:AL")

'Perform the VLOOKUP
FoundValue1 = Application.VLookup(LookupValue, LookupRange1, 5, False)
FoundValue2 = Application.VLookup(LookupValue, LookupRange2, 5, False)
FoundValue3 = Application.VLookup(LookupValue, LookupRange3, 5, False)
If Not IsError(Application.Union(FoundValue1, FoundValue2, FoundValue3)) Then

'If a value is found
DestinationRange.Value = Application.Union(FoundValue1, FoundValue2, FoundValue3)

'If a value is not found
If IsError(Application.Union(FoundValue1, FoundValue2, FoundValue3)) Then
DestinationRange.Value = Application.WorksheetFunction.IfError((Application.Union(FoundValue1, FoundValue2, FoundValue3)), "")
End If
End If
End Sub

However, from the coding that has been made so far, it cannot be run since there is a debug in
If Not IsError(Application.Union(FoundValue1, FoundValue2, FoundValue3)) Then --> "Object Required"

Please kindly help if you know the solution.
Thank you.

 

[CSmith]

Hi,
I have a question regarding how to create a VBA coding to Vlookup from multiple workbooks. However, if there is no value in the Vlookup, the destination column does not change into "N/A". Hence, I want it to keep it as it is.

Here's the coding that I have made:
Sub VLookupFromMultipleSources()

Dim SourceFile As Variant
Dim LookupValue As Variant
Dim WorkbookSource1 As Workbook
Dim WorkbookSource2 As Workbook
Dim WorkbookSource3 As Workbook
Dim LookupRange1 As Range
Dim LookupRange2 As Range
Dim LookupRange3 As Range
Dim DestinationRange As Range
Dim FoundValue1 As Variant
Dim FoundValue2 As Variant
Dim FoundValue3 As Variant

'Set the lookup value to the current cell
LookupValue = ThisWorkbook.Worksheets("LOG").Range("E:E")

'Define the lookup range in the source files
Set WorkbookSource1 = Workbooks.Open(ThisWorkbook.Path & "\Template Tracker PR AML BB1.xlsx")
Set LookupRange1 = WorkbookSource1.Worksheets("Tracker").Range("D3:H200")

Set WorkbookSource2 = Workbooks.Open(ThisWorkbook.Path & "\Template Tracker PR AML BB2.xlsx")
Set LookupRange2 = WorkbookSource2.Worksheets("Tracker").Range("D3:H200")

Set WorkbookSource3 = Workbooks.Open(ThisWorkbook.Path & "\Template Tracker PR AML BB3.xlsx")
Set LookupRange3 = WorkbookSource3.Worksheets("Tracker").Range("D3:H200")

'Set Destination Range
Set DestinationRange = ThisWorkbook.Worksheets("LOG").Range("AL:AL")

'Perform the VLOOKUP
FoundValue1 = Application.VLookup(LookupValue, LookupRange1, 5, False)
FoundValue2 = Application.VLookup(LookupValue, LookupRange2, 5, False)
FoundValue3 = Application.VLookup(LookupValue, LookupRange3, 5, False)
If Not IsError(Application.Union(FoundValue1, FoundValue2, FoundValue3)) Then

'If a value is found
DestinationRange.Value = Application.Union(FoundValue1, FoundValue2, FoundValue3)

'If a value is not found
If IsError(Application.Union(FoundValue1, FoundValue2, FoundValue3)) Then
DestinationRange.Value = Application.WorksheetFunction.IfError((Application.Union(FoundValue1, FoundValue2, FoundValue3)), "")
End If
End If
End Sub

However, from the coding that has been made so far, it cannot be run since there is a debug in
If Not IsError(Application.Union(FoundValue1, FoundValue2, FoundValue3)) Then --> "Object Required"

Please kindly help if you know the solution.
Thank you.

Because FoundValue1,2,3 are going to be a value type and not a range and Application.Union is looking for Ranges (objects) not values.

 

[christomunthe]

Because FoundValue1,2,3 are going to be a value type and not a range and Application.Union is looking for Ranges (objects) not values.

Hi CSmith, thank you for your answer.
I have the changed the coding into according:

Sub VLookupFromMultipleSources()

Dim SourceFile As Variant
Dim LookupValue As Variant
Dim WorkbookSource1 As Workbook
Dim WorkbookSource2 As Workbook
Dim WorkbookSource3 As Workbook
Dim LookupRange1 As Range
Dim LookupRange2 As Range
Dim LookupRange3 As Range
Dim DestinationRange As Range
Dim DestinationRangeValue As Range
Dim FoundValue As Variant

'Set the lookup value to the current cell
LookupValue = ThisWorkbook.Worksheets("LOG").Range("E:E")

'Define the lookup range in the source files
Set WorkbookSource1 = Workbooks.Open(ThisWorkbook.Path & "\Template Tracker PR AML BB1.xlsx")
Set LookupRange1 = WorkbookSource1.Worksheets("Tracker").Range("D3:H200")

Set WorkbookSource2 = Workbooks.Open(ThisWorkbook.Path & "\Template Tracker PR AML BB2.xlsx")
Set LookupRange2 = WorkbookSource2.Worksheets("Tracker").Range("D3:H200")

Set WorkbookSource3 = Workbooks.Open(ThisWorkbook.Path & "\Template Tracker PR AML BB3.xlsx")
Set LookupRange3 = WorkbookSource3.Worksheets("Tracker").Range("D3:H200")

'Set Destination Range
Set DestinationRange = ThisWorkbook.Worksheets("LOG").Range("AL:AL")

'Perform the VLOOKUP
FoundValue = Application.VLookup(LookupValue, Application.Union(LookupRange1, LookupRange2, LookupRange3), 5, False)
If Not IsError(FoundValue) Then

'If a value is found
DestinationRangeValue = FoundValue

'If a value is not found
If IsError(FoundValue) Then
DestinationRangeValue = Application.WorksheetFunction.IfError((FoundValue), "")
End If
End If
End Sub

However, the debug says --> Method 'union' of object "_Application" failed
Do you know how to solve this?

I'm very new in VBA but my boss wants me to do this. Any help would be much appreciated.
Thank you.

 

[CSmith]

I'm very new in VBA but my boss wants me to do this. Any help would be much appreciated.

What exactly is your boss wanting here?

 

[CSmith]

However, the debug says --> Method 'union' of object "_Application" failed

Most likely it failed as you are using a Range object in place of a value for the LookupValue.

 

[christomunthe]

So I'm trying to make a Vlookup into a certain destination workbook. However, the Vlookup range is from multiple workbooks. They have different file names but all of them have the same template (Lookup Range column, etc) but just different fillings.
For example Workbook 1 contains names of company a,y,z,l. Workbook 2 contains names of company b,t,g,h. Workbook 3. contains names of company x,i,d,w. etc.

But there's a catch. If the lookup result is not found (empty / error), the destination cell in the destination workbook will not be overwritten into "N/A" because in the source workbooks the list of the companies are not as much as in the lookup value (same with the destination workbook but different column). There is list of companies (lookup value) in the lookup value workbook that might not appear in the source workbooks (lookup range). Hence, since it could result to "N/A", instead of it changes the destination cell into "N/A", i want it to just stay empty (if it was empty before), or keep the original value (if previously have value). Otherwise, it changes align with the lookup range.

Here are the key points for the coding:
Workbook sources for the lookup range:
a). Workbook source 1: ("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB1.xlsx"). Worksheet ("Tracker"). Range("D3:D104000")
b). Workbook source 2: ("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB2.xlsx"). Worksheet ("Tracker"). Range("D3:D104000")
b). Workbook source 3: ("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB3.xlsx"). Worksheet ("Tracker"). Range("D3:D104000")

lookup value:
This workbook. worksheet("LOG"). Range("E2:E104000")

Destination Cell:
This workbook. worksheet("LOG"). Range("AL2:AL104000")

Lookup Command:
Vlookup(LookupValue, LookupRange, 5, False).

I hope my explanations are clear enough for you.

Thank you.

 

[christomunthe]

So I'm trying to make a Vlookup into a certain destination workbook. However, the Vlookup range is from multiple workbooks. They have different file names but all of them have the same template (Lookup Range column, etc) but just different fillings.
For example Workbook 1 contains names of company a,y,z,l. Workbook 2 contains names of company b,t,g,h. Workbook 3. contains names of company x,i,d,w. etc.

But there's a catch. If the lookup result is not found (empty / error), the destination cell in the destination workbook will not be overwritten into "N/A" because in the source workbooks the list of the companies are not as much as in the lookup value (same with the destination workbook but different column). There is list of companies (lookup value) in the lookup value workbook that might not appear in the source workbooks (lookup range). Hence, since it could result to "N/A", instead of it changes the destination cell into "N/A", i want it to just stay empty (if it was empty before), or keep the original value (if previously have value). Otherwise, it changes align with the lookup range.

Here are the key points for the coding:
Workbook sources for the lookup range:
a). Workbook source 1: ("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB1.xlsx"). Worksheet ("Tracker"). Range("D3:D104000")
b). Workbook source 2: ("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB2.xlsx"). Worksheet ("Tracker"). Range("D3:D104000")
b). Workbook source 3: ("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB3.xlsx"). Worksheet ("Tracker"). Range("D3:D104000")

lookup value:
This workbook. worksheet("LOG"). Range("E2:E104000")

Destination Cell:
This workbook. worksheet("LOG"). Range("AL2:AL104000")

Lookup Command:
Vlookup(LookupValue, LookupRange, 5, False).

I hope my explanations are clear enough for you.

Thank you.

Sorry there's a revision to the workbook sources:

Here are the key points for the coding:
Workbook sources for the lookup range:
a). Workbook source 1: ("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB1.xlsx"). Worksheet ("Tracker"). Range("D3:H104000")
b). Workbook source 2: ("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB2.xlsx"). Worksheet ("Tracker"). Range("D3:H104000")
b). Workbook source 3: ("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB3.xlsx"). Worksheet ("Tracker"). Range("D3:H104000")

Thank you.

 

[CSmith]

Try this:

' To enable faster lookups sort lookup worksheets
Sub VLookupFromMultipleSources()  'As is this will be very slow if the ranges are accurate . . .

    Dim SourceFile As Variant
    Dim LookupValue As Variant
    Dim WorkbookSource1 As Workbook
    Dim WorkbookSource2 As Workbook
    Dim WorkbookSource3 As Workbook
    Dim LookupRange1 As Range
    Dim LookupRange2 As Range
    Dim LookupRange3 As Range
    Dim SearchRange As Range
    Dim LookupBaseRange As Range
    Dim DestinationRange As Range
    Dim foundValue As Variant
    
    'Set the lookup value to the current cell
    Set SearchRange = ThisWorkbook.Worksheets("LOG").Range("E:E")
    lastrow = SearchRange.Cells(SearchRange.Rows.Count, 1).End(xlUp).Row ' Find last row in Base Range
    
    'Define the lookup range in the source files
    Set WorkbookSource1 = Workbooks.Open(ThisWorkbook.Path & "\File1.xlsx")
    Set LookupRange1 = WorkbookSource1.Worksheets("Tracker").Range("D3:H200")
    
    Set WorkbookSource2 = Workbooks.Open(ThisWorkbook.Path & "\File2.xlsx")
    Set LookupRange2 = WorkbookSource2.Worksheets("Tracker").Range("D3:H200")
    
    Set WorkbookSource3 = Workbooks.Open(ThisWorkbook.Path & "\File3.xlsx")
    Set LookupRange3 = WorkbookSource3.Worksheets("Tracker").Range("D3:H200")
    
    'Set Destination Range ; This to me implies same row on same sheet  from E to AL
    Set DestinationRange = ThisWorkbook.Worksheets("LOG").Range("AL:AL")
    Debug.Print DestinationRange.Column
    'Perform the VLOOKUP(s) not the most efficient way lots of rows will be pretty slow to run this just FYI
    For Each searchRow In SearchRange.Rows
        If searchRow.Row > lastrow Then Exit For
        If xlVLookupFindValue(searchRow.Offset(0, 0).Value, LookupRange1, 5, False, foundValue) = 0 Then
            'Found it
            Debug.Print "Found :" & searchRow.Offset(0, 0).Value&; " ; " & foundValue
            DestinationRange.Cells(searchRow.Row, 1).Value = foundValue
        ElseIf xlVLookupFindValue(searchRow.Offset(0, 0).Value, LookupRange2, 5, False, foundValue) = 0 Then
            'Found it
            Debug.Print "Found :" & searchRow.Offset(0, 0).Value&; " ; " & foundValue
            DestinationRange.Cells(searchRow.Row, 1).Value = foundValue
        ElseIf xlVLookupFindValue(searchRow.Offset(0, 0).Value, LookupRange3, 5, False, foundValue) = 0 Then
            'Found it
            Debug.Print "Found :" & searchRow.Offset(0, 0).Value&; " ; " & foundValue
            DestinationRange.Cells(searchRow.Row, 1).Value = foundValue
        End If
    Next
    'Cleanup
    Set SearchRange = Nothing
    Set DestinationRange = Nothing
    Set LookupRange1 = Nothing
    Set LookupRange2 = Nothing
    Set LookupRange3 = Nothing
    Set WorkbookSource1 = Nothing
    Set WorkbookSource2 = Nothing
    Set WorkbookSource3 = Nothing
    Debug.Print "Done!"
End Sub

Function xlVLookupFindValue(v As Variant, r As Range, col As Integer, NotExactMatch As Boolean, ByRef foundValue As Variant) As Long
    'Return false if not found otherwise return using the foundValue argument
    On Error Resume Next
    Err.Clear
    foundValue = Application.WorksheetFunction.VLookup(v, r, col, NotExactMatch)
    If Err.Number = 0 Then
        ' Found value
        xlVLookupFindValue = True
    Else
        xlVLookupFindValue = False
    End If
    xlVLookupFindValue = Err.Number
End Function

 

[CSmith]

Try this:

' To enable faster lookups sort lookup worksheets
Sub VLookupFromMultipleSources()  'As is this will be very slow if the ranges are accurate . . .

    Dim SourceFile As Variant
    Dim LookupValue As Variant
    Dim WorkbookSource1 As Workbook
    Dim WorkbookSource2 As Workbook
    Dim WorkbookSource3 As Workbook
    Dim LookupRange1 As Range
    Dim LookupRange2 As Range
    Dim LookupRange3 As Range
    Dim SearchRange As Range
    Dim LookupBaseRange As Range
    Dim DestinationRange As Range
    Dim foundValue As Variant
   
    'Set the lookup value to the current cell
    Set SearchRange = ThisWorkbook.Worksheets("LOG").Range("E:E")
    lastrow = SearchRange.Cells(SearchRange.Rows.Count, 1).End(xlUp).Row ' Find last row in Base Range
   
    'Define the lookup range in the source files
    Set WorkbookSource1 = Workbooks.Open(ThisWorkbook.Path & "\File1.xlsx")
    Set LookupRange1 = WorkbookSource1.Worksheets("Tracker").Range("D3:H200")
   
    Set WorkbookSource2 = Workbooks.Open(ThisWorkbook.Path & "\File2.xlsx")
    Set LookupRange2 = WorkbookSource2.Worksheets("Tracker").Range("D3:H200")
   
    Set WorkbookSource3 = Workbooks.Open(ThisWorkbook.Path & "\File3.xlsx")
    Set LookupRange3 = WorkbookSource3.Worksheets("Tracker").Range("D3:H200")
   
    'Set Destination Range ; This to me implies same row on same sheet  from E to AL
    Set DestinationRange = ThisWorkbook.Worksheets("LOG").Range("AL:AL")
    Debug.Print DestinationRange.Column
    'Perform the VLOOKUP(s) not the most efficient way lots of rows will be pretty slow to run this just FYI
    For Each searchRow In SearchRange.Rows
        If searchRow.Row > lastrow Then Exit For
        If xlVLookupFindValue(searchRow.Offset(0, 0).Value, LookupRange1, 5, False, foundValue) = 0 Then
            'Found it
            Debug.Print "Found :" & searchRow.Offset(0, 0).Value&; " ; " & foundValue
            DestinationRange.Cells(searchRow.Row, 1).Value = foundValue
        ElseIf xlVLookupFindValue(searchRow.Offset(0, 0).Value, LookupRange2, 5, False, foundValue) = 0 Then
            'Found it
            Debug.Print "Found :" & searchRow.Offset(0, 0).Value&; " ; " & foundValue
            DestinationRange.Cells(searchRow.Row, 1).Value = foundValue
        ElseIf xlVLookupFindValue(searchRow.Offset(0, 0).Value, LookupRange3, 5, False, foundValue) = 0 Then
            'Found it
            Debug.Print "Found :" & searchRow.Offset(0, 0).Value&; " ; " & foundValue
            DestinationRange.Cells(searchRow.Row, 1).Value = foundValue
        End If
    Next
    'Cleanup
    Set SearchRange = Nothing
    Set DestinationRange = Nothing
    Set LookupRange1 = Nothing
    Set LookupRange2 = Nothing
    Set LookupRange3 = Nothing
    Set WorkbookSource1 = Nothing
    Set WorkbookSource2 = Nothing
    Set WorkbookSource3 = Nothing
    Debug.Print "Done!"
End Sub

Function xlVLookupFindValue(v As Variant, r As Range, col As Integer, NotExactMatch As Boolean, ByRef foundValue As Variant) As Long
    'Return false if not found otherwise return using the foundValue argument
    On Error Resume Next
    Err.Clear
    foundValue = Application.WorksheetFunction.VLookup(v, r, col, NotExactMatch)
    If Err.Number = 0 Then
        ' Found value
        xlVLookupFindValue = True
    Else
        xlVLookupFindValue = False
    End If
    xlVLookupFindValue = Err.Number
End Function

I gave you the old function code it should have been:

Function xlVLookupFindValue(v As Variant, r As Range, col As Integer, NotExactMatch As Boolean, ByRef foundValue As Variant) As Long
    'Return false if not found otherwise return using the foundValue argument
    On Error Resume Next
    Err.Clear 
    foundValue = Application.WorksheetFunction.VLookup(v, r, col, NotExactMatch)
    xlVLookupFindValue = Err.Number
End Function

 

[CSmith]

Cleaned up version

Sub VLookupFromMultipleSources()

    Dim SourceFile As Variant
    Dim LookupValue As Variant
    Dim WorkbookSource1 As Workbook
    Dim WorkbookSource2 As Workbook
    Dim WorkbookSource3 As Workbook
    Dim LookupRange1 As Range
    Dim LookupRange2 As Range
    Dim LookupRange3 As Range
    Dim SearchRange As Range
    Dim LookupBaseRange As Range
    Dim DestinationRange As Range
    Dim foundValue As Variant
 
    'Set the Search Range
    Set SearchRange = ThisWorkbook.Worksheets("LOG").Range("E:E")
    lastrow = SearchRange.Cells(SearchRange.Rows.Count, 1).End(xlUp).Row ' Find last row in Base Range to stop when no more to find
 
    'Define the lookup range(s) in the source files
    Set WorkbookSource1 = Workbooks.Open("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB1.xlsx")
    Set LookupRange1 = WorkbookSource1.Worksheets("Tracker").Range("D3:H200")
 
    Set WorkbookSource2 = Workbooks.Open("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB2.xlsx")
    Set LookupRange2 = WorkbookSource2.Worksheets("Tracker").Range("D3:H200")
 
    Set WorkbookSource3 = Workbooks.Open("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB3.xlsx")
    Set LookupRange3 = WorkbookSource3.Worksheets("Tracker").Range("D3:H200")
 
    'Set Destination Range
    Set DestinationRange = ThisWorkbook.Worksheets("LOG").Range("AL:AL")

    'Perform the VLOOKUP(s)
    For Each searchRow In SearchRange.Rows
        If searchRow.Row > lastrow Then Exit For
        If xlVLookupFindValue(searchRow.Offset(0, 0).Value, LookupRange1, 5, False, foundValue) = 0 Then
            If DestinationRange.Cells(searchRow.Row, 1).Value = "" Or IsEmpty(DestinationRange.Cells(searchRow.Row, 1).Value) Then DestinationRange.Cells(searchRow.Row, 1).Value = foundValue
        ElseIf xlVLookupFindValue(searchRow.Offset(0, 0).Value, LookupRange2, 5, False, foundValue) = 0 Then
            If DestinationRange.Cells(searchRow.Row, 1).Value = "" Or IsEmpty(DestinationRange.Cells(searchRow.Row, 1).Value) Then DestinationRange.Cells(searchRow.Row, 1).Value = foundValue
        ElseIf xlVLookupFindValue(searchRow.Offset(0, 0).Value, LookupRange3, 5, False, foundValue) = 0 Then
            If DestinationRange.Cells(searchRow.Row, 1).Value = "" Or IsEmpty(DestinationRange.Cells(searchRow.Row, 1).Value) Then DestinationRange.Cells(searchRow.Row, 1).Value = foundValue
        End If
    Next

    'Cleanup
    Set SearchRange = Nothing
    Set DestinationRange = Nothing
    Set LookupRange1 = Nothing
    Set LookupRange2 = Nothing
    Set LookupRange3 = Nothing
    Set WorkbookSource1 = Nothing
    Set WorkbookSource2 = Nothing
    Set WorkbookSource3 = Nothing
End Sub

Function xlVLookupFindValue(v As Variant, r As Range, col As Integer, NotExactMatch As Boolean, ByRef foundValue As Variant) As Long
    'Return false if not found otherwise return using the foundValue argument
    On Error Resume Next
    Err.Clear
    foundValue = Application.WorksheetFunction.VLookup(v, r, col, NotExactMatch)
    xlVLookupFindValue = Err.Number
End Function