Excel VBA

css navigation by Css3Menu.com

Drill Down in Excel Charts

Several design protocols need to be followed to perform a drill down; most especially having the original data available for a secondary extract.

The swheet that the initial chart is on needs code like this:

Private Sub Chart_MouseUp(ByVal Button As Long, ByVal Shift As Long, _
                          ByVal x As Long, ByVal y As Long)
    Dim daShtName   As String
'   Description:Drill Down into Pivot Chart's data
'   Parameters: Button  Mouse botton that was released
'               Shift   State of SHIFT, CTRL, and ALT keys
'               x       Mouse pointer X coordinate within Chart
'               y       Mouse pointer Y coordinate within Chart
'   Example:    *none - This is an event handler

   On Error GoTo ErrHandler
    Dim ElementID As Long
    Dim Arg1 As Long
    Dim Arg2 As Long
'   Pass: x, y. Receive: ElementID, Arg1, Arg2
    ActiveChart.GetChartElement x, y, ElementID, Arg1, Arg2
'   If data element clicked, show detail
    If ElementID = 3 Then

        ActiveChart.PivotLayout.PivotTable.DataBodyRange. _
            Cells(Arg2, Arg1).ShowDetail = True
        ActiveSheet.Cells(2, 2).Select
        ActiveWindow.FreezePanes = True
        daShtName = ActiveSheet.Name
    End If
    If Err.Number = 0 Then
        BuildChemDrill (daShtName)
    End If

    On Error Resume Next
    On Error GoTo 0
End Sub

The data comes back into a new tab that needs to be formatted to make new charts

Sub BuildChimDrill(ShtNm)
' ChimTestdrill Macro
    Dim LastRow     As Long
    Dim TbNum
    Dim DrillTy     As String
    Dim daDate      As String
    Dim MachName    As String
    On Error GoTo ErrHand
    LastRow = Range("A665000").End(xlUp).Row    'LAST ROW
    TbNum = Right(ShtNm, Len(ShtNm) - 5)
    DrillTy = Sheets(ShtNm).Cells(2, 2) ' & "!$T$2"
    daDate = Sheets(ShtNm).Cells(2, 1)
    MachName = Sheets(ShtNm).Cells(2, 3) 'Line #
    CreateBuildChemPivot TbNum
    LastRow = Range("H665000").End(xlUp).Row    'LAST ROW
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("PivotCDrl" & TbNum & "!$H$4:$I$" & LastRow)
    ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="ChemDrillCht" & TbNum
    ActiveChart.ChartTitle.Caption = daDate & Chr(32) & " " & MachName & " Details"
    Exit Sub
     Select Case Err.Number
        Case 1004
            MsgBox "You clicked outside of the required area. You must click on a bar to drill down", vbCritical
        Case Else
            MsgBox "An unexpected error occurred, please report " _
                & Err.Number & vbCrLf & Err.Description, vbInformation
    End Select
End Sub

Of couse the customer wanted to see drill-down or the drill-down. At that time, I told her that she has the data, do what you wish with it.

© 2015-2024

Updated:  04/17/2024 12:26
This page added:  14 June 2015