Search code examples
excelworksheet

MS Excel - Macros for consolidating values from multiple sheets into a single sheet


Consider i have 4 workbooks with the following structure...

1. Main.xlsx
    Name    Jan   Feb  Mar
       A
       B
       C

2. Jan.xlsx       
     Name     Jan
      A       3.3
      B       6.4
      C       5.3

3. Feb.xlsx       
     Name     Feb
      A       1.3
      B       3.4
      C       5.5

4. Mar.xlsx       
     Name     Mar
      A       1.3
      B       3.4
      C       5.5

I need to combine them like

1. Main.xlsx
        Name    Jan   Feb  Mar
           A    3.3   1.3  1.3
           B    6.4   3.4  3.4
           C    5.3   5.5  5.5

And i need to automate the process...

And i guess i can do this with macros...? Can anyone suggest some way with which i can proceed with the macro?

Thanks for your time....


Solution

  • You can use ADO. Here are some notes.

    ''Must use macro-enabled file type, eg .xlsm
    ''The code was run from Main.xlsm, but should work in any 
    ''Excel file.
    Dim fs As Object
    Dim rs As Object
    Dim cn As Object
    Dim strSQL As String
    Dim strCon As String
    Dim i, f, s, m, ml
    Dim aFiles As Variant
    
    ''For looking up files, Dir would work, too
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    ''Array for file names and month names
    ''Space for months up to one less than the current month
    ReDim aFiles(Month(Date) - 2, 1)
    
    ''Fill the array ...
    For i = 1 To Month(Date) - 1
    
        ''With files called mmm.xlsx ...
        m = Format(CDate("2010/" & i & "/1"), "mmm")
        ''Found in C:\Docs
        f = "C:\Docs\" & m & ".xlsx"
    
        ''Checking first that the file exists
        If fs.FileExists(f) Then
            aFiles(i - 1, 0) = f
            aFiles(i - 1, 1) = m
        Else
            Debug.Print "Missing : " & f
        End If
    Next
    
    ''Build the SQL string ...
    For i = 1 To UBound(aFiles, 1)
        ''For joins, brackets = number of months -1
        strSQL = strSQL & "("
    Next
    
    ''Using Main.xlsm subquery as the basis for all Names ...
    strSQL = strSQL & "(SELECT [Name] FROM [Sheet1$] IN '' " _
       & "[Excel 8.0;database=C:\docs\Main.xlsm]) As Main LEFT JOIN "
    
    ''Left Join to all found files as subqueries aliased as mmm name ...
    For i = 0 To UBound(aFiles, 1)
        strSQL = strSQL & "(SELECT [Name]," & aFiles(i, 1) _
             & " FROM [Sheet1$] IN '' [Excel 8.0;database=" _
        & aFiles(i, 0) & "]) AS " & aFiles(i, 1) & " ON Main.Name = " & aFiles(i, 1) 
             & ".Name) LEFT JOIN "
    Next
    
    ''Remove final Left Join and bracket ...
    strSQL = Left(strSQL, Len(strSQL) - 12)
    
    ''Get a list of months ...
    For i = 0 To UBound(aFiles, 1)
        ml = ml & "," & aFiles(i, 1)
    Next
    
    ''Add the outer query, and that is the SQL string finished.
    strSQL = "SELECT Main.Name," & Mid(ml, 2) & " FROM " & strSQL
    
    ''This uses main.xlsm in the connection string, but it is
    ''not important which file is used because the SQL string
    ''is build using IN (keyword) to get the various files
    strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
        & Workbooks("main.xlsm").FullName _
        & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
    
    ''Connection and recordset objects
    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    
    cn.Open strCon
    
    rs.Open strSQL, cn
    
    ''Fill heading into Sheet2
    For i = 0 To rs.Fields.Count - 1
        Sheets("Sheet2").Cells(1, i + 1) = rs.Fields(i).Name
    Next
    
    ''Fill data into Sheet2
    Sheets("Sheet2").Cells(2, 1).CopyFromRecordset rs