Filter Pivot Table based on cell value

[ajm]

folks, I have picked up extendoffice's worksheet change event which filters a pivot table from the value entered into a particular cell.
https://www.extendoffice.com/documents/excel/5325-excel-pivot-table-filter-based-on-cell-value.html

it works really well. I am using a date range for my filter. how do I get the filter to accept a greater than date?

 

[DanteAmor]

The date has a different control than a text.
The following is assuming that the pivot table dates are as dd-mmm, example 30-sep. And in cell H6 you are capturing a date like 30-09-2019 or 30/09/2019

Try :

 Private Sub Worksheet_Change(ByVal Target As Range)'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField, xItem As PivotItem
    Dim xStr As String, n As Variant
    On Error Resume Next
    If Intersect(Target, Range("H6:H7")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Sheet1").PivotTables("PivotTable2")
    Set xPFile = xPTable.PivotFields("Date")
    xStr = CDate(Target.Text)
    xPFile.ClearAllFilters
    For Each xItem In xPFile.PivotItems
      'xPFile.CurrentPage = xStr
      n = CDate(xItem.Value & "-" & Year(Date))
      If n < xStr Then
        xItem.Visible = False
      End If
    Next
    Application.ScreenUpdating = True
End Sub

 

[ajm]

hi dante, thanks for looking at this for me. I have adjusted your code for my sheet name, pivot field, and single cell reference as below.

Private Sub Worksheet_Change(ByVal Target As Range) 'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField, xItem As PivotItem
    Dim xStr As String, n As Variant
    On Error Resume Next
    If Intersect(Target, Range("H6")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Top 10").PivotTables("PivotTable1")
    Set xPFile = xPTable.PivotFields("Order Date")
    xStr = CDate(Target.Text)
    xPFile.ClearAllFilters
    For Each xItem In xPFile.PivotItems
      'xPFile.CurrentPage = xStr
      n = CDate(xItem.Value & "-" & Year(Date))
      If n < xStr Then
        xItem.Visible = False
      End If
    Next
    Application.ScreenUpdating = True
End Sub[code/]

the code fires and picks up the correct date from h6 which is held by xStr. However, after that, no changes are made to the pivot.

 

[DanteAmor]

You could give an example of how your dates are in the cell and the pivot table.

 

[ajm]

hi dante, thanks for looking at this for me. I have adjusted your code for my sheet name, pivot field, and single cell reference as below.

Private Sub Worksheet_Change(ByVal Target As Range) 'Update by Extendoffice 20180702
    Dim xPTable As PivotTable
    Dim xPFile As PivotField, xItem As PivotItem
    Dim xStr As String, n As Variant
    On Error Resume Next
    If Intersect(Target, Range("H6")) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xPTable = Worksheets("Top 10").PivotTables("PivotTable1")
    Set xPFile = xPTable.PivotFields("Order Date")
    xStr = CDate(Target.Text)
    xPFile.ClearAllFilters
    For Each xItem In xPFile.PivotItems
      'xPFile.CurrentPage = xStr
      n = CDate(xItem.Value & "-" & Year(Date))
      If n < xStr Then
        xItem.Visible = False
      End If
    Next
    Application.ScreenUpdating = True
End Sub[code/]

the code fires and picks up the correct date from h6 which is held by xStr. However, after that, no changes are made to the pivot.[/QUOTE]

I'm a dope. my worksheet name was "Top10" - no space. I have amended this and now the code runs. It doesn't pick up the correct dates though. If i use 18/09/2018 or 18-Sep-18 as my date in H6, the filter returns only 15 April 2019. The dates in Order Date are formatted dd-Mmm-yy. would this matter?

 

[DanteAmor]

In my case, the dates on the pivot table appear like this (dd-mmm), Do not see the year, so the macro completes it. So, in your pivot table, how do the dates look?

 

[ajm]

raw data

Lease Type	Repair Agreement Type	Order Date
Services Only	Recharge Maintenance	17-May-18
Services Only	Recharge Maintenance	17-May-18
Services Only	Recharge Maintenance	17-May-18
Services Only	Recharge Maintenance	6-Feb-19
Services Only	Recharge Maintenance	6-Feb-19
Services Only	Recharge Maintenance	6-Feb-19
Services Only	Recharge Maintenance	6-Feb-19
Services Only	Recharge Maintenance	6-Feb-19
Services Only	Recharge Maintenance	6-Feb-19
Services Only	Recharge Maintenance	6-Feb-19
Services Only	Recharge Maintenance	6-Feb-19
Services Only	Recharge Maintenance	4-Apr-19
Services Only	Recharge Maintenance	4-Apr-19
Services Only	Recharge Maintenance	4-Apr-19
Services Only	Recharge Maintenance	1-Nov-18

<tbody>
</tbody>

pivot dates

can't seem to get the image for pivot dates to upload. they come through in the same format above dd-Mmm-YY

 

[ajm]

so, by changing the one line in the code from:

n = CDate(xItem.Value & "-" & Year(Date))

to

n = CDate(xItem.Value)

the macro runs through and compares the target date to each item in the Order Date filter box, but still does not filter the pivot table

 

[ajm]

further to the above, I reformatted the raw data Order Date column to dd/mm/yyyy and created a new pivot table on a new sheet. so now all dates are in the same format. using 18/9/2017 as my target date in H6, the resulting filter after the event code has run is completely random. this is so frustrating.

 

[ajm]

I have found a query on Chandoo's site (https://chandoo.org/forum/threads/updating-pivot-table-filter-with-date-range-vba.30954/) that I have put to use. this I what i have

Sub DateFilter()

'Set the Variables to be used
Dim pt As PivotTable
Dim SDate As Date
SDate = Worksheets("Top 10").Range("b1")
'Amend here to filter your data
Set pt = Worksheets("Top 10").PivotTables("PivotTable1")
    pt.PivotFields("Order Date").ClearAllFilters 'This line is needed to clear existing filter before applying new one
    pt.PivotFields("Order Date").PivotFilters.Add Type:=xlAfter, Value1:=CLng(SDate)
        
End Sub