Merge multiple Excel workbooks into single masterl

Question

I have the following code albeit incomplete as i am unsure how i can populate multiple columns and rows.

Code

Sub VlookMultipleWorkbooks()

    Dim lookFor As Range
    Dim srchRange As Range

    Dim book1 As Workbook
    Dim book2 As Workbook

    Dim book1Name As String
    book1Name = "destination.xls"    'modify it as per your requirement

    Dim book1NamePath As String
    book1NamePath = ThisWorkbook.Path & "\" & book1Name

    Dim book2Name As String
    book2Name = "source.xls"    'modify it as per your requirement

    Dim book2NamePath As String
    book2NamePath = ThisWorkbook.Path & "\" & book2Name

'    Set book1 = ThisWorkbook
    Set book1 = Workbooks(book1Name)

    If IsOpen(book2Name) = False Then Workbooks.Open (book2NamePath)
    Set book2 = Workbooks(book2Name)

    Set lookFor = book1.Sheets(1).Cells(2, 1)   ' value to find
    Set srchRange = book2.Sheets(1).Range("A:B")    'source

    lookFor.Offset(0, 1).Value = Application.VLookup(lookFor, srchRange, 2, False)

End Sub

My source file has the following structure

Name     Value1

My destination file has the following structure

Name     Value1

Problem 1

Currently the code only populates a single cell where i would like it to populate allow rows.

Problem 2

I need to be able to populate multiple columns. For example.

Name     Value1     Value2, etc

Problem 3

There are multiple source files that need to merge into a single master list.

Answer 1

EDIT: You could modify your initial design to take in two Range objects and an offset, then iterate as necessary. You'll need to open your workbooks and assign the Range objects elsewhere, but that doesn't seem to be the challenge right now. (Below is untested):

Sub EvenCoolerVLookup(SourceRange As Range, OffsetColumns As Long, LookupRange As Range)

Dim Cell As Range

'vet range objects and make sure they fail an Is Nothing test
'....

For Each Cell In SourceRange
    'do any special prep here
    '...
    Cell.Offset(0, OffsetColumns).Value = Application.VLookup(Cell, LookupRange, 2, False)
    'do any special cleanup here
    '...
Next Cell

'do anything else here
'....

End Sub

That should help you solve Problem 1. To solve Problem 2, you won't be able to use Application.Vlookup, but you can instead use Range.Find to return a Range object, from which you can grab the row via Range.Row.

Original Response: This should work to combine source files for Problem 3. The results will be saved as an xlsx file to the same directory as the file from which the code is run:

Option Explicit

'let's do some combining y'all!
Sub CombineSelectedFiles()

Dim TargetFiles As FileDialog
Dim TargetBook As Workbook, CombinedBook As Workbook
Dim TargetSheet As Worksheet, CombinedSheet As Worksheet
Dim TargetRange As Range, AddNewRange As Range, _
    FinalRange As Range
Dim LastRow As Long, LastCol As Long, Idx As Long, _
    LastCombinedRow As Long
Dim CombinedFileName As String
Dim RemoveDupesArray() As Variant

'prompt user to pick files he or she would like to combine
Set TargetFiles = UserSelectMultipleFiles("Pick the files you'd like to combine:")
If TargetFiles.SelectedItems.Count = 0 Then Exit Sub '<~ user clicked cancel

'create a destination book for all the merged data
Set CombinedBook = Workbooks.Add
Set CombinedSheet = CombinedBook.ActiveSheet

'loop through the selected workbooks and combine data
For Idx = 1 To TargetFiles.SelectedItems.Count

    Set TargetBook = Workbooks.Open(TargetFiles.SelectedItems(Idx))
    Set TargetSheet = TargetBook.ActiveSheet

    If Idx = 1 Then
        TargetSheet.Cells.Copy Destination:=CombinedSheet.Cells(1, 1)
    Else
        LastRow = FindLastRow(TargetSheet)
        LastCol = FindLastCol(TargetSheet)
        With TargetSheet
            Set TargetRange = .Range(.Cells(2, 1), .Cells(LastRow, LastCol))
        End With
        LastCombinedRow = FindLastRow(CombinedSheet)
        With CombinedSheet
            Set AddNewRange = .Range(.Cells(LastCombinedRow + 1, 1), _
                .Cells(LastCombinedRow + 1 + LastRow, LastCol))
        End With
        TargetRange.Copy Destination:=AddNewRange
    End If

    TargetBook.Close SaveChanges:=False

Next Idx

'set up a final range for duplicate removal
LastCombinedRow = FindLastRow(CombinedSheet)
With CombinedSheet
    Set FinalRange = .Range(.Cells(1, 1), .Cells(LastCombinedRow, LastCol))
End With

'populate the array for use in the duplicate removal
ReDim RemoveDupesArray(LastCol)
For Idx = 0 To (LastCol - 1)
    RemoveDupesArray(Idx) = Idx + 1
Next Idx
FinalRange.RemoveDuplicates Columns:=Evaluate(RemoveDupesArray), Header:=xlYes

'save the results
CombinedFileName = ThisWorkbook.Path & "\Combined_Data"
Application.DisplayAlerts = False
CombinedBook.SaveAs FileName:=CombinedFileName, FileFormat:=51
CombinedBook.Close SaveChanges:=False
Application.DisplayAlerts = True

End Sub

'prompt user to select files then return the selected fd object
Public Function UserSelectMultipleFiles(DisplayText As String) As FileDialog

Dim usmfDialog As FileDialog

Set usmfDialog = Application.FileDialog(msoFileDialogOpen)
With usmfDialog
    .AllowMultiSelect = True
    .Title = DisplayText
    .ButtonName = ""
    .Filters.Clear
    .Filters.Add ".xlsx files", "*.xlsx"
    .Filters.Add ".xlsb files", "*.xlsb"
    .Filters.Add ".xlsm files", "*.xlsm"
    .Filters.Add ".xls files", "*.xls"
    .Filters.Add ".csv files", "*.csv"
    .Filters.Add ".txt files", "*.txt"
    .Show
End With
Set UserSelectMultipleFiles = usmfDialog
End Function

'identify last row in a worksheet
Public Function FindLastRow(Sheet As Worksheet) As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        FindLastRow = Sheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Else
        FindLastRow = 1
    End If
End Function

'identify last col in a worksheet
Public Function FindLastCol(Sheet As Worksheet) As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        FindLastCol = Sheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    Else
        FindLastCol = 1
    End If
End Function