Excel VBA

Drill Down in Excel Charts

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
    
ErrHandler:
   

    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
    Sheets(ShtNm).Activate
    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
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Range("PivotCDrl" & TbNum & "!$H$4:$I$" & LastRow)
    ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="ChemDrillCht" & TbNum
    ActiveChart.ChartArea.Select
    ActiveChart.PlotArea.Select
    ActiveChart.Axes(xlCategory).Select
    ActiveChart.PlotArea.Select
    ActiveChart.ChartTitle.Caption = daDate & Chr(32) & " “" & MachName & "” Details"
    Exit Sub
ErrHand:
     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