Select date range in chart buttons


New Member
Jan 15, 2015
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

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
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
    InterpretButtons "Current YTD"
    InterpretButtons "Last Month"
    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)
    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
                    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
    End With

End Sub
Upvote 0

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back