Input 2 files and create 3rd file

[pivotguy]

I have a challenges where I have two input files


1. Emp-Input.xlsx 2. Zip-Input file.xlsx


I am creating a 3^rd workbook (Emp-Zip-Output.xlsx) file taking data from the two input files.The original file contains thousands of records. Can you suggest a VBA code to automate the process?

Zip-Emp-OUTPUT File

ZIP (Column A) : These values comes from “zip-input” file.
TERRITORY (Column B) : These values comes from “zip-input” file.

FIRST NAME (Column C) : These values comes from “emp-input” file that match Territory (Column B) against TERRITORY (Column B) of “Output” file.

LAST NAME (Column D) : These values comes from “emp-input” file that match Territory (Column B) against TERRITORY (Column B) of “Output” file.

Region(Column E) : These values comes from “emp-input” file that match Territory (Column B) against TERRITORY (Column B) of “Output” file

[pivotguy]

I appreciate any response on this issue.

[mancubus]

save your output file as xlsm.

open vbe, paste the below code in a standard module and set a reference to "Microsoft ActiveX Data Objects X.X Library"

Sub vbax_55490_join_sheets_in_diff_wbs()

    Dim cn As New ADODB.Connection, rs As New ADODB.Recordset
    Dim strSQL As String
    Dim j As Long
    
    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With
    
    cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" _
            & "Data Source=" & ThisWorkbook.Path & "\Zip-Input.xlsx;" _
            & "Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1""")
    strSQL = "SELECT * FROM [Sheet1$]"
    rs.Open strSQL, cn, adOpenStatic, adLockReadOnly
    Worksheets.Add.Name = "zip_inp"
    With Worksheets("zip_inp")
        For j = 1 To rs.Fields.Count
            .Cells(1, j).Value = rs.Fields(j - 1).Name
        Next j
        .Range("A2").CopyFromRecordset rs
    End With
    rs.Close
    cn.Close

    cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" _
            & "Data Source=" & ThisWorkbook.Path & "\Emp-Input.xlsx;" _
            & "Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1""")
    strSQL = "SELECT * FROM [Sheet1$]"
    rs.Open strSQL, cn, adOpenStatic, adLockReadOnly
    Worksheets.Add.Name = "emp_inp"
    With Worksheets("emp_inp")
        For j = 1 To rs.Fields.Count
            .Cells(1, j).Value = rs.Fields(j - 1).Name
        Next j
        .Range("A2").CopyFromRecordset rs
    End With
    rs.Close
    cn.Close

    cn.Open ("Provider=Microsoft.ACE.OLEDB.12.0;" _
            & "Data Source=" & ThisWorkbook.FullName & ";" _
            & "Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1""")
    strSQL = _
        "SELECT z.Zip, z.Territory, e.[FIRST NAME], e.[LAST NAME], z.Region " & _
        "FROM [zip_inp$] AS z " & _
        "LEFT JOIN [emp_inp$] AS e ON z.Territory = e.Territory;"
    rs.Open strSQL, cn, adOpenStatic, adLockReadOnly
    With Worksheets("Output")
        .Cells.Clear
        For i = 0 To rs.Fields.Count - 1
            .Cells(1, i + 1).Value = rs.Fields(i).Name
        Next i
        .Cells(2, 1).CopyFromRecordset rs
    End With
    rs.Close
    cn.Close

    Worksheets("zip_inp").Delete
    Worksheets("emp_inp").Delete

End Sub

[pivotguy]

mancubus : Excellent Code. No issue. Worked like a charm. Thanks you very much for your help.

[mancubus]

you are welcome.

i assumed all three workbooks are in the same folder, and sheet names are Sheet1. from the feedback i understand it is so.

if the files are in different folders, ThisWorkbook.Path bit in the connection strings must be replaced with the actual folders the input workbookworks are in. and the Sheet1$ ($ sign is important here) bits must be replaced with the actual sheet names.