VBA lookup by taking common column from user

[sanju1988]

Sub VlookupDataAcrossMultipleTabs()
Dim mainFile As Workbook
Dim lookupFile As Workbook
Dim mainSheet As Worksheet
Dim lookupSheet As Worksheet
Dim mainFilePath As String
Dim lookupFilePath As String
Dim mainCol As String
Dim lookupCol As String
Dim lookupCols As String
Dim lookupColsArray() As String
Dim lastRowMain As Long
Dim lastRowLookup As Long
Dim cell As Range
Dim i As Long
Dim colNum As Long
Dim lookupValue As Variant
Dim saveFolderPath As String
Dim newFileName As String

' Select the main file
mainFilePath = Application.GetOpenFilename("Excel Files (*.xls; *.xlsx), *.xls; *.xlsx", , "Select Main File")
If mainFilePath = "False" Then Exit Sub
Set mainFile = Workbooks.Open(mainFilePath)

' Select the lookup file
lookupFilePath = Application.GetOpenFilename("Excel Files (*.xls; *.xlsx), *.xls; *.xlsx", , "Select Lookup File")
If lookupFilePath = "False" Then Exit Sub
Set lookupFile = Workbooks.Open(lookupFilePath)

' Select the save folder
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select the folder to save the updated main file"
If .Show = -1 Then
saveFolderPath = .SelectedItems(1)
Else
Exit Sub
End If
End With

' Loop through each sheet in the main file
For Each mainSheet In mainFile.Worksheets
' Get the common column in main file
mainCol = InputBox("Enter the common column name in main file (Sheet: " & mainSheet.Name & ")")

' Loop through each sheet in the lookup file
For Each lookupSheet In lookupFile.Worksheets
' Get the common column in lookup file
lookupCol = InputBox("Enter the common column name in lookup file (Sheet: " & lookupSheet.Name & ")")

' Get the columns to lookup from the lookup file
lookupCols = InputBox("Enter the columns to lookup from lookup file (comma separated, Sheet: " & lookupSheet.Name & ")")
lookupColsArray = Split(lookupCols, ",")

' Find the last row in both sheets
lastRowMain = mainSheet.Cells(mainSheet.Rows.Count, mainCol).End(xlUp).Row
lastRowLookup = lookupSheet.Cells(lookupSheet.Rows.Count, lookupCol).End(xlUp).Row

' Perform the lookup
For Each cell In mainSheet.Range(mainCol & "2:" & mainCol & lastRowMain)
lookupValue = Application.Match(cell.Value, lookupSheet.Range(lookupCol & "1:" & lookupCol & lastRowLookup), 0)

If Not IsError(lookupValue) Then
For i = LBound(lookupColsArray) To UBound(lookupColsArray)
colNum = Application.Match(Trim(lookupColsArray(i)), lookupSheet.Rows(1), 0)
If Not IsError(colNum) Then
cell.Offset(0, i + 1).Value = lookupSheet.Cells(lookupValue, colNum).Value
End If
Next i
End If
Next cell
Next lookupSheet
Next mainSheet

' Ask for the new file name and save the main file
newFileName = InputBox("Enter the new file name (without extension):")
mainFile.SaveAs Filename:=saveFolderPath & "\" & newFileName & ".xlsx"
mainFile.Close SaveChanges:=True
lookupFile.Close SaveChanges:=False

MsgBox "VLOOKUP operation completed successfully. File saved as " & saveFolderPath & "\" & newFileName & ".xlsx", vbInformation
End Sub

 

[sanju1988]

.Trying to vlookup by selecting common column and lookup columns but giving error

 

[StephenCrump]

It would help if you told us which line of code produces the error, and what error message you're getting.

But I'm guessing you are getting a Type mismatch error on the first line below, if a MATCH fails, because you have declared colNum as Long, rather than Variant?

colNum = Application.Match(Trim(lookupColsArray(i)), lookupSheet.Rows(1), 0)
If Not IsError(colNum) Then
    '.....