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]

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

Could make faster checking if there is a cell value in the results column and not doing the lookups if one exists . . .

 

[CSmith]

Final code cleanup . . .

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, searchRow 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 to stop when no more to find
    
    'Open and/or attach to files to search
    Set WorkbookSource1 = Workbooks.Open("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB1.xlsx")
    Set WorkbookSource2 = Workbooks.Open("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB2.xlsx")
    Set WorkbookSource3 = Workbooks.Open("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB3.xlsx")
    
    'Define the lookup range(s) in the source files
    Set LookupRange1 = WorkbookSource1.Worksheets("Tracker").Range("D3:H200")
    Set LookupRange2 = WorkbookSource2.Worksheets("Tracker").Range("D3:H200")
    Set LookupRange3 = WorkbookSource3.Worksheets("Tracker").Range("D3:H200")
    
    'Set Destination Range
    Set DestinationRange = ThisWorkbook.Worksheets("LOG").Range("AL:AL")
    
    'Iterate across the given range
    For Each searchRow In SearchRange.Rows
        If searchRow.Row > lastrow Then Exit For 'Quit if no more to process
        If DestinationRange.Cells(searchRow.Row, 1).Value = "" Or IsEmpty(DestinationRange.Cells(searchRow.Row, 1).Value) Then GoTo SkipRow ' Skip if data exists already in return column
        'Perform the VLOOKUP(s) and set destination cell value
        If xlVLookupFindValue(searchRow.Offset(0, 0).Value, LookupRange1, 5, False, foundValue) = 0 Then ' Check first workbook
            DestinationRange.Cells(searchRow.Row, 1).Value = foundValue
        ElseIf xlVLookupFindValue(searchRow.Offset(0, 0).Value, LookupRange2, 5, False, foundValue) = 0 Then ' Check next workbook
            DestinationRange.Cells(searchRow.Row, 1).Value = foundValue
        ElseIf xlVLookupFindValue(searchRow.Offset(0, 0).Value, LookupRange3, 5, False, foundValue) = 0 Then ' Check next workbook
            DestinationRange.Cells(searchRow.Row, 1).Value = foundValue
        End If
SkipRow: ' Used to skip over cells with value already
    Next
    
    'Cleanup memory objects
    Set searchRow = Nothing
    Set DestinationRange = Nothing
    Set SearchRange = 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
    On Error Resume Next ' We know there may be error doing the lookup so ignore and return the error number
    Err.Clear
    foundValue = Application.WorksheetFunction.VLookup(v, r, col, NotExactMatch) ' this will update the foundValue argument if lookup succeeds
    'Function Return 0 or error number value
    xlVLookupFindValue = Err.Number
End Function

 

[christomunthe]

Omg CSmith, thank you so much.

Very much appreciated.

However, I've made the VBA using this code and it works:

Sub VLookupToDestinationRemarks()

Dim wbDest As Workbook
Dim wsDest As Worksheet
Dim rngLookupValue As Range, rngDest As Range
Dim lookupValue As Variant
Dim lookupRange As Variant
Dim lookupRanges As Variant
Dim i As Long, j As Long, lastRow As Long

'Set the destination workbook and worksheet
Set wbDest = ThisWorkbook
Set wsDest = wbDest.Worksheets("LOG")

'Set the lookup value range
Set rngLookupValue = wsDest.Range("E2:E" & wsDest.Cells(wsDest.Rows.Count, "E").End(xlUp).Row)

'Set the destination range
Set rngDest = wsDest.Range("AL2:AL" & wsDest.Cells(wsDest.Rows.Count, "AL").End(xlUp).Row)

'Load the lookup ranges into memory as arrays
ReDim lookupRanges(1 To 3)
For j = 1 To 3
Dim wbSource As Workbook
Dim wsSource As Worksheet
Set wbSource = Workbooks.Open("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB" & j & ".xlsx")
Set wsSource = wbSource.Worksheets("Tracker")
lastRow = wsSource.Cells(wsSource.Rows.Count, "D").End(xlUp).Row
lookupRanges(j) = wsSource.Range("D3:H" & lastRow).Value
wbSource.Close SaveChanges:=False
Next j

'Loop through each cell in the lookup value range
For i = 1 To rngLookupValue.Rows.Count

'Get the lookup value
lookupValue = rngLookupValue.Cells(i, 1).Value

'Set the default value for the destination cell
If rngDest.Cells(i, 1).Value = "" Then
rngDest.Cells(i, 1).Value = ""
End If

'Loop through each source workbook
For j = 1 To 3

'Get the lookup result from memory
lookupRange = Application.VLookup(lookupValue, lookupRanges(j), 5, False)

'Check if the lookup result is not empty or error
If Not IsError(lookupRange) And Not IsEmpty(lookupRange) Then

'Update the destination cell
rngDest.Cells(i, 1).Value = lookupRange

'Exit the loop for the current lookup value
Exit For

End If

Next j

Next i

End Sub

But, I have another catch, so the VBA above will only change the destination cell if the destination cell have fill & empty into the value from the source workbook / cell (meaning there's a fill inside the cell). if the source workbook / cell have a value (but it's empty) it will not change destination cell into empty if previously there's a fill inside. Do you know how to modify the code?

Thank you, Thank you, Thank you

 

[CSmith]

Omg CSmith, thank you so much.

Very much appreciated.

However, I've made the VBA using this code and it works:

. . .

But, I have another catch, so the VBA above will only change the destination cell if the destination cell have fill & empty into the value from the source workbook / cell (meaning there's a fill inside the cell). if the source workbook / cell have a value (but it's empty) it will not change destination cell into empty if previously there's a fill inside. Do you know how to modify the code?

Thank you, Thank you, Thank you

I provided code that does this already . . .
You might add your code into the provided code below . . .

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, searchRow 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 to stop when no more to find
    
    'Open and/or attach to files to search
    Set WorkbookSource1 = Workbooks.Open("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB1.xlsx")
    Set WorkbookSource2 = Workbooks.Open("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB2.xlsx")
    Set WorkbookSource3 = Workbooks.Open("C:\Users\id9chrim\Desktop\PR Tracker\Template Tracker PR AML BB3.xlsx")
    
    'Define the lookup range(s) in the source files
    Set LookupRange1 = WorkbookSource1.Worksheets("Tracker").Range("D3:H200")
    Set LookupRange2 = WorkbookSource2.Worksheets("Tracker").Range("D3:H200")
    Set LookupRange3 = WorkbookSource3.Worksheets("Tracker").Range("D3:H200")
    
    'Set Destination Range
    Set DestinationRange = ThisWorkbook.Worksheets("LOG").Range("AL:AL")
    
    'Iterate across the given range
    For Each searchRow In SearchRange.Rows
        If searchRow.Row > lastrow Then Exit For 'Quit if no more to process
        If DestinationRange.Cells(searchRow.Row, 1).Value = "" Or IsEmpty(DestinationRange.Cells(searchRow.Row, 1).Value) Then GoTo SkipRow ' Skip if data exists already in return column
        'Perform the VLOOKUP(s) and set destination cell value
        If xlVLookupFindValue(searchRow.Offset(0, 0).Value, LookupRange1, 5, False, foundValue) = 0 Then ' Check first workbook
            DestinationRange.Cells(searchRow.Row, 1).Value = foundValue
        ElseIf xlVLookupFindValue(searchRow.Offset(0, 0).Value, LookupRange2, 5, False, foundValue) = 0 Then ' Check next workbook
            DestinationRange.Cells(searchRow.Row, 1).Value = foundValue
        ElseIf xlVLookupFindValue(searchRow.Offset(0, 0).Value, LookupRange3, 5, False, foundValue) = 0 Then ' Check next workbook
            DestinationRange.Cells(searchRow.Row, 1).Value = foundValue
        End If
SkipRow: ' Used to skip over cells with value already
    Next
    
    'Cleanup memory objects
    Set searchRow = Nothing
    Set DestinationRange = Nothing
    Set SearchRange = 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
    On Error Resume Next ' We know there may be error doing the lookup so ignore and return the error number
    Err.Clear
    foundValue = Application.WorksheetFunction.VLookup(v, r, col, NotExactMatch) ' this will update the foundValue argument if lookup succeeds
    'Function Return 0 or error number value
    xlVLookupFindValue = Err.Number
End Function