Beyond Excel: VBA and Database Manipulation

Mar 4 2010   6:32PM GMT

Drill Down – Part 2



Posted by: Craig Hatmaker
Tags:
database
development
excel
Microsoft Excel
ms query
odbc
sql
tutorial
vba

Before we get to coding, let’s look at the final product.  When we click our ‘easy’ button, our spreadsheet prompts us for dates, customers, and products.  If we just take the defaults, everything will be loaded from the NorthWinds database – like this:

Drill Down Before

Drill Down Before

If we look in the ‘Orders’ column we see that some lines have more than one order supporting them.  If we double click anywhere in the second line (say cell A6 for example) our finished spreadsheet will display those two orders so we can know the detail behind our summary.  It will look like this:

Drill Down After

Drill Down After

Now, as mentioned in the previous post, we need to restructure our code a bit.  We need to eliminate the Macro1() in our module, and create three routines in the sheet’s class (for how to get to the sheet’s class review prior post).  So here is the first bit of code – constants that will make modifying this template for use on other databases easier:

Const sConnect = "Driver={Microsoft Access Driver (*.mdb, *.accdb)};" & _
                 "DBQ=C:\Users\chatmaker\Documents\Northwind 2007.accdb;"
Const sData = "Data"
                 

These constants go at the very top of our sheet’s class.   And, as before, you will need to modify the path to your copy of the Northwind database (highlighted in red).

The next bit of code is the sheet’s double click event handler.  When you double click on worksheet ‘Data’, this even automatically fires.  All we need to do is wire it up to do what we want.  In this case, we want to load the detail associated with the Customer ID and Product Code on the line that is double clicked.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   
'   Worksheet_BeforeDoubleClick:  Excel's double click event handler
'   Parameters: Target  Cell that was double clicked
'               Cancel
'   Example:    <Automatically called when user double clicks worksheet>
'     Date   Init Modification
'   02/23/10 CWH  Initial Programming
    On Error GoTo ErrHandler            '
   
    If NameExists(sData) Then
       
        Dim lColDta As Long
            lColDta = Range(sData).Column
        Dim lColCus As Long
            lColCus = lColDta + FieldColumn("Customer ID", sData) - 1
        Dim lColPrd As Long
            lColPrd = lColDta + FieldColumn("Product Code", sData) - 1
       
        Get_Data "Fields_Detail", _
                 Trim(Cells(Target.Row, lColCus)), _
                 Trim(Cells(Target.Row, lColPrd)), _
                 frmPrompt.pFrom, frmPrompt.pTo
    End If
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Worksheet_BeforeDoubleClick - Error#" & Err.Number & vbCrLf _
        & Err.Description, vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
End Sub

 

As you can see, there’s not much to it.  But it requires a new routine ‘Get_Data’.  ‘Get_Data’ is half of our Macro1() – the part that doesn’t ask for any information but instead builds the SQL and submits it.  It looks like this:

Private Function Get_Data(sFields As String, _
                  sID1 As String, sID2 As String, _
                  dFrom As Date, dTo As Date) As Boolean
'   Get_Data:   Processes request from Prompt or Worksheet_BeforeDoubleClick
'   Parameters: sFields Name of the Field Definition table
'               sID1    Customer ID(s)
'               sID2    Product code(s)
'               dFrom   Ordered date range start
'               dTo     Ordered date range stop
'   Example:    If .pOK Then Get_Data "Fields", "8", "'NWC-14', 'NWCA-21'", _
'                                      Int(now())-30, Int(Now())
'     Date   Init Modification
'   02/23/10 CWH  Initial Programming
    On Error GoTo ErrHandler            '
    Get_Data = Failure                  'Assume the Worst
    Dim sSQL As String
           
    sSQL = "SELECT  " & Build_SQL_Select_Fields(sFields) & vbCr & _
           "FROM    Customers C, Orders O, " & vbCr & _
           "        `Order Details` D, Products P " & vbCr & _
           "WHERE   O.`Customer ID` = C.ID " & vbCr & _
           "  AND   O.`Order ID`    = D.`Order ID` " & vbCr & _
           "  AND   D.`Product ID`  = P.ID " & vbCr & _
           "  AND   O.`Order Date` Between #" & _
                    Format(dFrom, "mm/dd/yyyy") & "# And #" & _
                    Format(dTo, "mm/dd/yyyy") & "# " & vbCr & _
            Build_SQL_ID("O.`Customer ID`", Trim(sID1), False) & vbCr & _
            Build_SQL_ID("P.`Product Code`", Trim(sID2), True) & vbCr & _
            "GROUP BY " & Build_SQL_Group_By(sFields, "*")
    
    SQLLoad sSQL, sConnect, "A4", "Data", "Data"
    If NameExists(sData) Then
        If Range(sData).Rows.Count > 1 Then
            Add_XLFormula sData, sFields
            Freeze_Pane sData, sFields
            Sort_Data sData, sFields
            Format_Results sData, sFields
            If sFields = "Fields_Detail" Then Pivot_Template
        End If
    End If
   
    Get_Data = Success                  'Successful finish
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Get_Data - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
End Function

That should look very familiar to you.  The reason we split this from the part of Macro1() that asks for input is because we want only one routine to load data for us – whether the input comes from frmPrompt or from Worksheet_BeforeDoubleClick.

So now all we need to do is add back the part that sets up and displays frmPrompt.  It looks like this:

Private Sub Prompt()
'   Prompt:     Ask user for report parameters
'   Parameters: None
'   Example:    Prompt
'     Date   Init Modification
'   02/23/10 CWH  Initial Programming
    On Error GoTo ErrHandler            '
    With frmPrompt
               
        .pDateLbl = "Ordered Dates"
        .pFromVisible = True
        .pFrom = "01/01/2006"
        .pToVisible = True
        .pTo = Format(Now(), "mm/dd/yyyy")
       
        .pID1Visible = True
        .pID1Lbl = "Customer ID(s)"
        .pTitle1 = "Select Customers"
        .pConnect1 = sConnect
        .pLblCode1 = "Code"
        .pSQLCode1 = "Select   ID as Code, " & _
                              "Company as Name " & vbCr & _
                     "From     Customers " & vbCr & _
                     "Where    ID like '%?%' " & vbCr & _
                     "Order By ID"
        .pLblDesc1 = "Company"
        .pSQLDesc1 = "Select   ID as Code, " & _
                              "Company as Name " & vbCr & _
                     "From     Customers " & vbCr & _
                     "Where    Company like '%?%' " & vbCr & _
                     "Order By Company"
       
        .pID2Visible = True
        .pID2Lbl = "Product Code(s)"
        .pConnect2 = sConnect
        .pLblCode2 = "Code"
        .pSQLCode2 = "Select   `Product Code` as Code, " & _
                              "`Product Name` as Name " & vbCr & _
                     "From     Products " & vbCr & _
                     "Where    `Product Code` like '%?%' " & vbCr & _
                     "Order By `Product Code`"
        .pLblDesc2 = "Name"
        .pSQLDesc2 = "Select   `Product Code` as Code, " & _
                              "`Product Name` as Name " & vbCr & _
                     "From     Products " & vbCr & _
                     "Where    `Product Name` like '%?%' " & vbCr & _
                     "Order By `Product Name`"
                    
       .Show                                         'Display the Prompt
        Do While .Visible                            'Wait on user
            DoEvents
        Loop
        If .pOK Then Get_Data "Fields", _
                              Trim(UCase(.pID1)), Trim(UCase(.pID2)), _
                              .pFrom, .pTo
    End With
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Prompt - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
End Sub

When you’re finished make sure to get rid of Macro1(), and then right click on the ‘easy’ button and assign it to macro ‘Sheet1.Prompt’. 

There’s one more advantage to structuring our code this way – almost all of the code that needs to be modified to use this template on just about any other database – AS/400, SQL Server, Oracle, MySQL, etc – on just about any table or set of tables – is contained in this one sheet.  This makes adapting this very quick and easy.

 Comment on this Post

 
There was an error processing your information. Please try again later.
Thanks. We'll let you know when a new response is added.
Send me notifications when other members comment.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to: