Drill Down – Part 2
Posted by: Craig Hatmaker
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:
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:
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.






