VBA One Click Combine

🔄 Smart Excel Macro for Merging Records into a Master File

Managing multiple Excel files can be a daunting task—especially when you're dealing with bank statements, vendor records, or invoice details. To simplify this process, I’ve developed a custom Excel VBA macro that intelligently merges records into a master file while handling duplicates and allowing column-level customization.

⚙️ Key Features

• Duplicate Detection: Prevents redundant entries based on unique identifiers.
• Custom Column Selection: Choose which columns to import.
• Flexible Use Cases: Works for bank statements, vendor data, invoices, and more.
• Timestamped Saving: Optional versioning with timestamps for traceability.

🛠️ How It Works

• Select the source Excel file.
• Define which columns to copy.
• Macro checks for duplicates in the master file.
• Clean data is appended and saved.

💡 Why This Macro Matters

Manual data consolidation is time-consuming and error-prone. This macro automates the process while giving you full control over what gets imported—perfect for professionals who value data integrity.

🚀 Want to Try It?

Below full code and a step-by-step tutorial soon. Stay tuned—and feel free to leave a comment if you’d like a custom version for your workflow!

📜 Sample VBA Code

  Option Explicit

Sub ImportBankData()
    Dim keyWb As Workbook, bankWb As Workbook, targetWb As Workbook
    Dim keyWs As Worksheet, bankWs As Worksheet, targetWs As Worksheet
    Dim bankFile As String, targetFile As String
    Dim headerMap As Object
    Dim lastRow As Long, lastCol As Long, i As Long
    Dim targetHeader As Variant, bankHeader As String
    Dim dictExisting As Object
    Dim newRow As Long
    Dim bankHeaders As Object, targetHeaderCols As Object
    Dim rowKey As String
    Dim openingBalCol As Long, closingBalCol As Long
    Dim debitCol As Long, creditCol As Long
    Dim openingBal As Double, debitVal As Double, creditVal As Double
    Dim sNo As Long
    Dim duplicateCount As Long, uniqueCount As Long

    ' Set reference to Key workbook and Input sheet
    Set keyWb = ThisWorkbook
    Set keyWs = keyWb.Sheets("Input")

    ' Build header mapping dictionary: key = Target Header, value = Bank Header
    Set headerMap = CreateObject("Scripting.Dictionary")
    For i = 1 To 20
        If UCase(Trim(keyWs.Cells(i, 4).Value)) = "Y" Then
            bankHeader = Trim(keyWs.Cells(i, 2).Value)
            targetHeader = Trim(keyWs.Cells(i, 3).Value)
            If targetHeader <> "" And bankHeader <> "" Then
                headerMap(targetHeader) = bankHeader
            End If
        End If
    Next i

    If headerMap.Count = 0 Then
        MsgBox "No headers marked 'Y' in Input sheet.", vbExclamation
        Exit Sub
    End If

    ' Browse and open Bank Statement workbook
    bankFile = fl_browse()
    If bankFile = "" Then Exit Sub
    Set bankWb = Workbooks.Open(bankFile)
    Set bankWs = bankWb.Sheets(1)

    ' Browse and open Target workbook
    targetFile = fl_browse()
    If targetFile = "" Then Exit Sub
    Set targetWb = Workbooks.Open(targetFile)
    Set targetWs = targetWb.Sheets("JPMC")

    ' Map target headers to their column numbers
    Set targetHeaderCols = CreateObject("Scripting.Dictionary")
    lastCol = targetWs.Cells(1, targetWs.Columns.Count).End(xlToLeft).Column
    For i = 1 To lastCol
        targetHeaderCols(targetWs.Cells(1, i).Value) = i
    Next i

    ' Validate required headers
    If Not targetHeaderCols.exists("Opening Balance") Then
        MsgBox "'Opening Balance' column not found in target sheet.", vbCritical
        Exit Sub
    End If
    If Not targetHeaderCols.exists("Closing Balance") Then
        MsgBox "'Closing Balance' column not found in target sheet.", vbCritical
        Exit Sub
    End If

    openingBalCol = targetHeaderCols("Opening Balance")
    closingBalCol = targetHeaderCols("Closing Balance")
    If targetHeaderCols.exists("Debit") Then debitCol = targetHeaderCols("Debit")
    If targetHeaderCols.exists("Credit") Then creditCol = targetHeaderCols("Credit")

    ' Map bank headers to their column numbers
    Set bankHeaders = CreateObject("Scripting.Dictionary")
    lastCol = bankWs.Cells(1, bankWs.Columns.Count).End(xlToLeft).Column
    For i = 1 To lastCol
        bankHeaders(bankWs.Cells(1, i).Value) = i
    Next i

    ' Create dictionary of existing rows to avoid duplicates
    Set dictExisting = CreateObject("Scripting.Dictionary")
    lastRow = targetWs.Cells(targetWs.Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastRow
        rowKey = ""
        For Each targetHeader In headerMap.Keys
            If targetHeaderCols.exists(targetHeader) Then
                rowKey = rowKey & "|" & NormalizeValue(targetWs.Cells(i, targetHeaderCols(targetHeader)).Value)
            End If
        Next
        If rowKey <> "" Then dictExisting(rowKey) = True
    Next i

    ' Determine starting row and opening balance
    newRow = lastRow + 1
    If lastRow < 2 Then
        openingBal = 0
        sNo = 1
    Else
        openingBal = val(targetWs.Cells(lastRow, closingBalCol).Value)
        sNo = val(targetWs.Cells(lastRow, 1).Value) + 1
    End If

    ' Loop through Bank Statement rows
    lastRow = bankWs.Cells(bankWs.Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastRow
        rowKey = ""
        For Each targetHeader In headerMap.Keys
            bankHeader = headerMap(targetHeader)
            If bankHeaders.exists(bankHeader) Then
                rowKey = rowKey & "|" & NormalizeValue(bankWs.Cells(i, bankHeaders(bankHeader)).Value)
            End If
        Next

        If Not dictExisting.exists(rowKey) Then
            targetWs.Cells(newRow, 1).Value = sNo

            ' Insert mapped values
            For Each targetHeader In headerMap.Keys
                bankHeader = headerMap(targetHeader)
                If bankHeaders.exists(bankHeader) And targetHeaderCols.exists(targetHeader) Then
                    targetWs.Cells(newRow, targetHeaderCols(targetHeader)).Value = bankWs.Cells(i, bankHeaders(bankHeader)).Value
                End If
            Next

            ' Get debit/credit values
            debitVal = 0: creditVal = 0
            If debitCol > 0 Then debitVal = val(targetWs.Cells(newRow, debitCol).Value)
            If creditCol > 0 Then creditVal = val(targetWs.Cells(newRow, creditCol).Value)

            ' Calculate and format balances
            With targetWs.Cells(newRow, openingBalCol)
                .Value = openingBal
                .NumberFormat = "#,##0.00"
            End With

            With targetWs.Cells(newRow, closingBalCol)
                .Value = openingBal + creditVal - debitVal
                .NumberFormat = "#,##0.00"
            End With

            openingBal = openingBal + creditVal - debitVal
            dictExisting(rowKey) = True
            newRow = newRow + 1
            sNo = sNo + 1
            uniqueCount = uniqueCount + 1
        Else
            duplicateCount = duplicateCount + 1
        End If
    Next i

    MsgBox "? Data import complete!" & vbCrLf & _
           "? Unique rows added: " & uniqueCount & vbCrLf & _
           "?? Duplicate rows skipped: " & duplicateCount, vbInformation
           
           
                  
           targetWb.SaveAs targetWb.Path & "\" & targetWb.Name & Format(Now, "yyyy-mm-dd_HHmm") & ".xlsx"
          targetWb.Close savechanges:=False
          bankWb.Close savechanges:=False
          
           
           
           
           
End Sub


Private Function NormalizeValue(val As Variant) As String
    If IsNumeric(val) Then
        NormalizeValue = Format(val, "0.00")
    ElseIf IsDate(val) Then
        NormalizeValue = Format(val, "yyyy-mm-dd")
    Else
        NormalizeValue = Trim(CStr(val))
    End If
End Function


 

Below code input in other modules

  
Option Explicit

Public Function fl_browse() As String
    Dim fd As FileDialog
    Dim selectedFile As String

    ' Initialize the FileDialog object
    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    With fd
        .Title = "Select a File"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm"
        .Filters.Add "All Files", "*.*"
        .InitialFileName = ThisWorkbook.Path & "\"

        ' Show the dialog box
        If .Show = -1 Then ' -1 means user clicked "Open"
            selectedFile = .SelectedItems(1)
        Else
            selectedFile = "" ' User cancelled
        End If
    End With

    ' Return the selected file path
    fl_browse = selectedFile
End Function

  

🎨 Want to Customize this Template?

This project is fully customizable. You can:

• Add HTML formatting to the email body
• Attach files dynamically
• Include CC/BCC recipients
• Pull data from multiple sheets or sources

📞 Need a Custom Email Automation Tool?

If you'd like to customize this template for your business—whether it's branding, attachments, or advanced logic—feel free to connect with us. We’d love to help you streamline your workflow and save time.

👉 Contact us today to get started with your personalized Excel email automation solution!