Select date range in chart buttons

[finspa]

Hi all

I want to create a dashboard with a number of charts on with user filters - slicers. One of the filters I would like to include is a date range. Obvioulsy when you create a pivot table or chart you have specific date filters, This Quarter, This Year etc.

I would like to have a 'global' filter, like a slicer but under the assumption that the user has no knowledge of pivot tables and charts, i.e. i want big buttons for them to select "YTD", "Last month" and so on.

Is this possible?!

Many thanks

 

[pbornemeier]

Replace K_Date in
Const sDatePivotFieldName As String = "K_Date"
with the name of the date variable in your pivot chart. That variable should be in the Report Filter portion of the Pivot

Option Explicit

Sub Test_FilterPT()
    FilterPT DateSerial(2015, 4, 1), DateSerial(2015, 5, 0), "April 2015"  'DateSerial(2015, 5, 0) is a way of representing last day in April 2015
    Stop
    InterpretButtons "Current YTD"
    Stop
    InterpretButtons "Last Month"
    Stop
    InterpretButtons "Last Year"
    
End Sub
Sub InterpretButtons(sID As String)
    'The buttons on your chart should call this sub with appropriate parameter
    'This sub calls the FilterPT to actually manipulate your PivotChart
    
    Dim lCurrentYear As Long
    Dim lCurrentMonth As Long
    Dim lCurrentDay As Long
    Dim lCurrentQuarterStartMonth As Long
    Dim lCurrentQuarter As Long
    Dim aryQuarterInfo As Variant
    
    lCurrentYear = Year(Now())
    lCurrentMonth = Month(Now())
    lCurrentDay = Day(Now())
    aryQuarterInfo = ReturnQuarterInfo(Now())
    lCurrentQuarterStartMonth = aryQuarterInfo(0)
    lCurrentQuarter = aryQuarterInfo(1)

    Select Case sID
    Case "Current YTD"
        FilterPT DateSerial(lCurrentYear, 1, 1), DateSerial(lCurrentYear, lCurrentMonth, lCurrentDay), "CY " & lCurrentYear & " To Date"
    Case "Current QTD"
        FilterPT DateSerial(lCurrentYear, lCurrentQuarterStartMonth, 1), DateSerial(lCurrentYear, lCurrentQuarterStartMonth + 3, 0), Format(Now(), "yy") & "Q" & lCurrentQuarter & " To Date"
    Case "Last Month"
        FilterPT DateSerial(lCurrentYear, lCurrentMonth - 1, 1), DateSerial(lCurrentYear, lCurrentMonth, 0), Format(DateSerial(lCurrentYear, lCurrentMonth, 0), "mmm yyyy")
        'Note: DateSerial(lCurrentYear, lCurrentMonth, 0) returns the date of the last day of the previous month
    Case "Last Quarter"
        FilterPT DateSerial(lCurrentYear, lCurrentQuarterStartMonth - 3, 1), DateSerial(lCurrentYear, lCurrentQuarterStartMonth, 0), _
            Format(DateSerial(lCurrentYear, lCurrentQuarterStartMonth - 3, 1), "yy") & "Q" & ReturnQuarterInfo(DateSerial(lCurrentYear, lCurrentQuarterStartMonth - 3, 1))(1)
    Case "Last Year"
        FilterPT DateSerial(lCurrentYear - 1, 1, 1), DateSerial(lCurrentYear, 1, 0), lCurrentYear - 1 & " To Date"
        'Note: DateSerial(lCurrentYear, 1, 0) returns the last day of the previous year
    Case Else
        MsgBox "Date Range Not Defined", , "Bad Dates"
    End Select
End Sub

Function ReturnQuarterInfo(dteInput As Date) As Variant
    ReturnQuarterInfo = Array(Choose(Month(dteInput), 1, 1, 1, 4, 4, 4, 7, 7, 7, 10, 10, 10), _
        Choose(Month(dteInput), 1, 1, 1, 2, 2, 2, 3, 3, 3, 4, 4, 4))
End Function
Sub FilterPT(dteStart As Date, dteEnd As Date, sGraphTitle As String)
    'http://www.mrexcel.com/forum/excel-questions/860722-select-date-range-chart-buttons.html
    Debug.Print Now(), dteStart, dteEnd, sGraphTitle
    
    'This code should be run when the PivotChart is on the activeworksheet
    'Set up the pivot chart with the date field to be manipulated in the PivotChart Report Filter
    Const sDatePivotFieldName As String = "K_Date"
    Dim pi As PivotItem
    Dim sTitle As String
    
    With ActiveSheet.PivotTables(1)    'PivotChart
        .PivotFields(sDatePivotFieldName).EnableMultiplePageItems = True
        .PivotFields(sDatePivotFieldName).CurrentPage = "(All)"
        ActiveSheet.ChartObjects(1).Chart.SetElement (msoElementChartTitleAboveChart)
        
        Application.ScreenUpdating = False
        With .PivotFields(sDatePivotFieldName)
            On Error Resume Next    'If it happens that there are none
            For Each pi In .PivotItems
                If CDate(pi) >= dteStart And CDate(pi) <= dteEnd Then
                    pi.Visible = True
                Else
                    pi.Visible = False 'will raise error if there is nothing left visible
                    If Err.number = 1004 Then
                        'Unable to set the Visible property of the PivotItem class
                        MsgBox "No records meet that criteria (can't hide the last one that does not).  Try another filter", , "No Records Meet Criteria Selected"
                        sGraphTitle = "No Records Meet Criteria Selected - Bad Graph"
                        Exit For
                    End If
                End If
            Next pi
            On Error GoTo 0
        End With
        ActiveSheet.ChartObjects(1).Chart.ChartTitle.Text = sGraphTitle
        Application.ScreenUpdating = True
        Err.Clear
    End With

End Sub