Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

How to combine two tables into one?

Posted on 2014-08-06
4
Medium Priority
?
273 Views
Last Modified: 2014-08-12
I am trying to figure out a way to take a list of packages my runners can apply for and summarize by runner, the items in that package. You will see on the attached spreadsheet. There are 3 tabs. The first tab is the packages my runners can apply for. Each package (Bronze, Silver, Gold) has multiple lines (Shoe Reward & Shoe Discount). You will see on the second tab (Runners) are a list of a few of my runners and which package they applied for. On the third tab (RESULTS), that is how I am wanting the results to end up looking like. That RESULTS tab shows the runners, package, shoe reward and shoe discount. The RESULTS tab combines the information from the Packages and Runners tabs. Does that make sense? Any ideas how I can do this? Thanks!!
Example.xlsx
0
Comment
Question by:brasiman
4 Comments
 
LVL 24

Expert Comment

by:SunBow
ID: 40245264
HW
0
 
LVL 1

Expert Comment

by:csehz
ID: 40245455
Checking your RESULTS sheet that seems a typical task in MS Access, importing/linking the Packages and Runners sheets as Tables and creating a simple Query to show them in one list.

If you do not have Access then maybe this link you find as direction to go
http://exceluser.com/formulas/msquery-excel-relational-data.htm
0
 
LVL 16

Accepted Solution

by:
Jerry Paladino earned 2000 total points
ID: 40247926
If you are running Excel 2010 or higher the attached file may solve your requirements.  (Sorry - I don't have a copy of Excel 2007 to test with).   This VBA solution uses the ADO Extensions (ADOX) to create a temporary Access Db in the background and then reads the two input tables from your Excel file to create the Tables in the Access Db.   It then runs a SQL query to combine the two tables in Access and the Excel file reads the combined results into the "NewResults" worksheet before it deletes the temporary Access db.  

Add as many packages and runners to the Excel table as you need and use the Blue macro button to run the VBA and build the results table.
Option Explicit

'---------------------------------------------------------------------------------------
' Procedure : Clear_Table
' Author    : Jerry Paladino (ProdOps)
' Date      : August 7, 2014
' Purpose   : EE-Q_28492263 - Clear the Results Table
'---------------------------------------------------------------------------------------
'
Sub Clear_Table()

    With ThisWorkbook.Sheets("NewResults").ListObjects.Item(1)
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
    End With

End Sub


'---------------------------------------------------------------------------------------
' Procedure : Create_Results
' Author    : Jerry Paladino (ProdOps)
' Date      : August 7, 2014
' Purpose   : EE-Q_28492263 - Query / Combine two Tables
'---------------------------------------------------------------------------------------
'
Sub Create_Results()

    On Error GoTo errHandler
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With

    ' Create a Temporary Access Db
    Call Create_accdb_AccessDb
    ' Create the Access Table "Tbl_Packages" in the new Access Db
    Call MakeAccessTable(ThisWorkbook.FullName, "Packages", "Tbl_Packages")
    ' Create the Access Table "Tbl_Runners" in the new Access Db
    Call MakeAccessTable(ThisWorkbook.FullName, "Runners", "Tbl_Runners")
    ' Create a new Table with the results of the combined tables in Access Db
    Call RunSQL

    ' Update the Query in the "NewResults" worksheet to read the Results table from Access
    With ThisWorkbook.Sheets("NewResults").ListObjects.Item(1)
        If Not .DataBodyRange Is Nothing Then
            .DataBodyRange.Delete
        End If
        .QueryTable.Refresh BackgroundQuery:=False
        .QueryTable.MaintainConnection = False  ' Drops the connection to MS-Access
    End With

    ' Delete the temporary MS-Access File - It is no longer needed
    Kill Range("AccessDb").Value

finished:

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    Exit Sub

errHandler:
    MsgBox "ErrNum= " & Err.Number & ", ErrDesc = " & Err.Description & _
    ", 'MOD_RefreshData', 'Create_accdb_AccessDb", vbCritical, "Application Error"
    Resume finished

End Sub


'---------------------------------------------------------------------------------------
' Procedure : Create_accdb_AccessDb
' Author    : Jerry Paladino (ProdOps)
' Date      : August 7, 2014
' Purpose   : EE-Q_28492263 - Creates a 2007/2010 Access Db with a location
'             and name based on the Range Name "AccessDb"
'---------------------------------------------------------------------------------------
'
Function Create_accdb_AccessDb()

    Dim cat As New ADOX.Catalog
    Dim newDb As String
    On Error GoTo errHandler

    newDb = Range("AccessDb").Value

TryAgain:
    cat.Create "Provider='Microsoft.ACE.OLEDB.12.0';" & _
               "Data Source='" & newDb & "'"

finished:
    Set cat = Nothing
    Debug.Print newDb & " created."
    Exit Function

errHandler:
    ' If the Access Db name already exists the Create File will fail.
    ' Delete the current Access Db and resume to "TryAgain:" to
    ' create a blank database after the old one has been deleted.
    If Err.Number = -2147217897 Then
        Kill newDb
        Resume TryAgain
    Else
        MsgBox "ErrNum= " & Err.Number & ", ErrDesc = " & Err.Description & _
        ", 'MOD_RefreshData', 'Create_accdb_AccessDb", vbCritical, "Application Error"
        Resume finished
    End If

End Function



'---------------------------------------------------------------------------------------
' Procedure : MakeAccessTable
' Author    : Jerry Paladino (ProdOps)
' Date      : August 7, 2014
' Purpose   : EE-Q_28492263 - Creates Table in Access using an Excel worksheet as Datasource
'---------------------------------------------------------------------------------------
'
Sub MakeAccessTable(XLName As String, ShtName As String, TblName As String)

    Dim cn As Object
    Dim strQuery As String
    Dim myDB As String
    Dim xlLoc As String

    On Error GoTo errHandler

    Set cn = CreateObject("ADODB.Connection")

    myDB = Range("AccessDb").Value
    xlLoc = "'" & XLName & "'[Excel 12.0;]"

    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"    'For *.ACCDB Databases
        .ConnectionString = myDB
        .Open
    End With

    strQuery = "SELECT * INTO " & TblName & " FROM [" & ShtName & "$] IN " & xlLoc & ";"
    Debug.Print strQuery
    cn.Execute "DROP TABLE " & TblName

skip:
    cn.Execute strQuery
    cn.Close

finished:

    Set cn = Nothing
    Exit Sub

errHandler:
    ' If Access Table does not exist the DROP TABLE will fail,
    ' resume skip to continue with the MakeTbl query
    If Err.Number = -2147217865 Then
        Resume skip
    Else
        MsgBox "ErrNum= " & Err.Number & ", ErrDesc = " & Err.Description & _
        ", 'MOD_RefreshData', 'Create_accdb_AccessDb", vbCritical, "Application Error"
        Resume finished
    End If

End Sub


'---------------------------------------------------------------------------------------
' Procedure : RunSQL
' Author    : Jerry Paladino (ProdOps)
' Date      : August 7, 2014
' Purpose   : EE-Q_28492263 - Runs a SQL Statement in the new Access Db
'---------------------------------------------------------------------------------------
'
Sub RunSQL()

    Dim cn As Object
    Dim strQry As String
    Dim myDB As String
    Dim dq As String

    On Error GoTo errHandler

    Set cn = CreateObject("ADODB.Connection")

    myDB = Range("AccessDb").Value
    dq = """"

    With cn
        .Provider = "Microsoft.ACE.OLEDB.12.0"    'For *.ACCDB Databases
        .ConnectionString = myDB
        .Open
    End With

    strQry = "SELECT tr.[Runner Name], tp.Package, tp.[Shoe Reward], tp.[Shoe Discount] " & vbCrLf & _
             "INTO Tbl_Results " & vbCrLf & _
             "FROM Tbl_Packages tp INNER JOIN Tbl_Runners tr ON tp.Package = tr.[Package Application];"

    Debug.Print strQry
    cn.Execute "DROP TABLE tbl_Confirmed"

skip:
    cn.Execute strQry
    cn.Close

finished:

    Set cn = Nothing
    Exit Sub

errHandler:
    ' If Access Table does not exist the DROP TABLE will fail,
    ' resume to skip to continue with the Insert Into (MakeTbl) query
    If Err.Number = -2147217865 Then
        Resume skip
    Else
        MsgBox "ErrNum= " & Err.Number & ", ErrDesc = " & Err.Description & _
        ", 'MOD_RefreshData', 'Create_accdb_AccessDb", vbCritical, "Application Error"
        Resume finished
    End If

End Sub


'---------------------------------------------------------------------------------------
' Procedure : ChangeQTPath
' Author    : Jerry Paladino (ProdOps)
' Date      : August 7, 2014
' Purpose   : EE-Q_28492263 - Relinks all QueryTables in the Wokbook to a new Path name
'             if the file has been moved since the last time it ran.  This procedure is
'             called from the ThisWorkbook events on Open and Save
'---------------------------------------------------------------------------------------
'
Sub ChangeQTPath(OldPath As String, NewPath As String)
    On Error GoTo errHandler

    Dim lstObj As ListObject
    Dim queryTbl As QueryTable
    Dim wkSht As Worksheet
    Dim I As Long

    'Make sure file path variables end with "\"
    If Right(OldPath, 1) <> "\" Then OldPath = OldPath & "\"
    If Right(NewPath, 1) <> "\" Then NewPath = NewPath & "\"

    For Each wkSht In ThisWorkbook.Worksheets

        Debug.Print wkSht.Name

        For I = 1 To 10             '  Change up to 10 QueryTbls per worksheet
            Set lstObj = wkSht.ListObjects(I)
            Set queryTbl = lstObj.QueryTable

            Debug.Print wkSht.Name & " - ORIGINAL - " & queryTbl.SourceDataFile

            queryTbl.Connection = Application.Substitute(queryTbl.Connection, OldPath, "DELETED_PATH_STRING\")
            queryTbl.Connection = Application.Substitute(queryTbl.Connection, "DELETED_PATH_STRING\", NewPath)

            queryTbl.SourceDataFile = Application.Substitute(queryTbl.SourceDataFile, OldPath, "DELETED_PATH_STRING\")
            queryTbl.SourceDataFile = Application.Substitute(queryTbl.SourceDataFile, "DELETED_PATH_STRING\", NewPath)

            Debug.Print wkSht.Name & " - REVISED - " & queryTbl.SourceDataFile

            Set lstObj = Nothing
            Set queryTbl = Nothing
        Next I

skip:
    Next wkSht

finished:
    Exit Sub

errHandler:
    ' If there is no query table a Subscript out of Range error will be thrown,
    ' resume skip to continue to the next worksheet
    If Err.Number = 9 Then
        Resume skip
    ElseIf Err.Number = 1004 And Err.Description = "Application-defined or object-defined error" Then
        Resume skip
    Else
        MsgBox "ErrNum= " & Err.Number & ", ErrDesc = " & Err.Description & _
        ", 'MOD_RefreshData', 'Create_accdb_AccessDb", vbCritical, "Application Error"
        Resume finished
    End If

End Sub

Open in new window

EE-Q-28492263-Combine-Tables.xlsm
0
 

Author Closing Comment

by:brasiman
ID: 40255734
Worked perfectly! Thanks!
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
Windows Explorer lets you open cabinet (cab) files like any other folder. In VBA you can easily handle normal files and folders, but opening and indeed creating cabinet files takes a lot more - and that's you'll find here.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

581 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question