Macro to Filter Pivot Table on List of Dates

sushi514

New Member
Joined
Nov 13, 2020
Messages
18
Hi All,

I'm trying to get a pivot table to filter on records that have a specific date tied to them. I want to reference a list of specific dates that I have on a separate sheet called "py calendar" - the list of dates are currently from A2:A27 on here, but can vary.
With sheet "Approvals" and pivot table being "PivotTable1"

Sub filterdates()

Dim PT As PivotTable
Dim PF As PivotField
Dim Sh As Worksheet
Dim Dates As Date


Set Sh = ThisWorkbook.Sheets("Approvals")
Set PT = Sh.PivotTables("PivotTable1")
Set PF = PT.PivotFields("Approval Date")

PT.ClearAllFilters

PF.PivotFilters.Add Type:=x1SpecificDate, Value1:this is what I'm not sure of



End Sub

Or I'm trying this:

Sub filter2()

Dim Dates As String

Dates = Worksheets("py calendar").Range("A:A").Value

Sheets("Approvals").PivotTables("PivotTable1").PivotFields("Approval Date").CurrentPage = Dates

End Sub
 

Some videos you may like

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

GlennUK

Well-known Member
Joined
Jul 8, 2002
Messages
11,547
It's be something similar to this:
VBA Code:
Sub autofilt()
    Dim blnWanted As Boolean
    '
    ' make sure wanted items are visible
    '
    For Each it In ActiveSheet.PivotTables("PivotTable2").PivotFields("Date").PivotItems
        For Each el In Sheets("Sheet3").Range("A2:A6")
            If it.Name = Format(el.Value, "m/d/yyyy") Then
                it.Visible = True
                Exit For
            End If
        Next
    Next
    '
    '   now hide items that are not wanted
    '
    For Each it In ActiveSheet.PivotTables("PivotTable2").PivotFields("Date").PivotItems
        blnWanted = False
        For Each el In Sheets("Sheet3").Range("A2:A6")
            If it.Name = Format(el.Value, "m/d/yyyy") Then
                blnWanted = True
                Exit For
            End If
        Next
        If Not blnWanted Then
            it.Visible = False
        End If
    Next

End Sub
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,455
Or, maybe...


VBA Code:
Sub filterdates()

    Dim PT As PivotTable
    Dim PF As PivotField
    Dim PI As PivotItem
    Dim Sh As Worksheet
    Dim Dates As Variant
    
    On Error GoTo exitHandler
    
    With ThisWorkbook.Sheets("py calendar")
        Dates = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
    End With
    
    Set Sh = ThisWorkbook.Sheets("Approvals")
    Set PT = Sh.PivotTables("PivotTable1")
    Set PF = PT.PivotFields("Approval Date")
    
    PT.ClearAllFilters
    
    For Each PI In PF.PivotItems
        If IsError(Application.Match(PI.Name, Dates, 0)) Then
            PI.Visible = False
        End If
    Next PI
    
    Exit Sub
    
exitHandler:
    PF.ClearAllFilters

End Sub
 
Last edited:

sushi514

New Member
Joined
Nov 13, 2020
Messages
18
It's be something similar to this:
VBA Code:
Sub autofilt()
    Dim blnWanted As Boolean
    '
    ' make sure wanted items are visible
    '
    For Each it In ActiveSheet.PivotTables("PivotTable2").PivotFields("Date").PivotItems
        For Each el In Sheets("Sheet3").Range("A2:A6")
            If it.Name = Format(el.Value, "m/d/yyyy") Then
                it.Visible = True
                Exit For
            End If
        Next
    Next
    '
    '   now hide items that are not wanted
    '
    For Each it In ActiveSheet.PivotTables("PivotTable2").PivotFields("Date").PivotItems
        blnWanted = False
        For Each el In Sheets("Sheet3").Range("A2:A6")
            If it.Name = Format(el.Value, "m/d/yyyy") Then
                blnWanted = True
                Exit For
            End If
        Next
        If Not blnWanted Then
            it.Visible = False
        End If
    Next

End Sub
Thank you! Was curious as to how I could expand the Range to look at a list that is not specific to a set of cells, where the Range will not always end at cell A6, but variable in: For Each el In Sheets("Sheet3").Range("A2:A6")

I tried replacing with .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value but this did not seem to work
 

sushi514

New Member
Joined
Nov 13, 2020
Messages
18

ADVERTISEMENT

Or, maybe...


VBA Code:
Sub filterdates()

    Dim PT As PivotTable
    Dim PF As PivotField
    Dim PI As PivotItem
    Dim Sh As Worksheet
    Dim Dates As Variant
   
    On Error GoTo exitHandler
   
    With ThisWorkbook.Sheets("py calendar")
        Dates = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
    End With
   
    Set Sh = ThisWorkbook.Sheets("Approvals")
    Set PT = Sh.PivotTables("PivotTable1")
    Set PF = PT.PivotFields("Approval Date")
   
    PT.ClearAllFilters
   
    For Each PI In PF.PivotItems
        If IsError(Application.Match(PI.Name, Dates, 0)) Then
            PI.Visible = False
        End If
    Next PI
   
    Exit Sub
   
exitHandler:
    PF.ClearAllFilters

End Sub
Thank you! I was trying to use this code as it was easier for me to interpret; however, when running it did not actually filter on any dates, but the code did not throw an error, either.
For clarity purposes, I've uploaded images of what I'm trying to filter on.
 

Attachments

  • Pivot.png
    Pivot.png
    27 KB · Views: 3
  • Dates.png
    Dates.png
    14.1 KB · Views: 3

GlennUK

Well-known Member
Joined
Jul 8, 2002
Messages
11,547
Thank you! Was curious as to how I could expand the Range to look at a list that is not specific to a set of cells, where the Range will not always end at cell A6, but variable in: For Each el In Sheets("Sheet3").Range("A2:A6")

I tried replacing with .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value but this did not seem to work
you used .Cells ... so where is the parent? Did you use a With somewhere, or what? I'm guessing it's not pointing at the same sheet as Range("A2 ... so won't work.
 

sushi514

New Member
Joined
Nov 13, 2020
Messages
18

ADVERTISEMENT

Apologies, but I am pretty new to VBA coding. It is pointing to the same sheet.

I had: For Each el In Sheets("py calendar").Range("A2:A28") which worked, but wanted to replace it with something along the lines of this:
For Each el In Sheets("py calendar").Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value

I guess what you are saying is I need to have:
With ThisWorkbook.Sheets("py calendar")
Dates = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
End With

but I'm unsure as to how that would work with the original line you gave: "For Each el"
 

Domenic

MrExcel MVP
Joined
Mar 10, 2004
Messages
19,455
Thank you! I was trying to use this code as it was easier for me to interpret; however, when running it did not actually filter on any dates, but the code did not throw an error, either.
For clarity purposes, I've uploaded images of what I'm trying to filter on.
It's probably because your pivot table contains no items whose date matches a date from your list of dates. I have amended the macro to indicate when this is the case. Post back if this does not address the issue.

VBA Code:
Sub filterdates()

    Dim PT As PivotTable
    Dim PF As PivotField
    Dim PI As PivotItem
    Dim Sh As Worksheet
    Dim Dates As Variant
    
    On Error GoTo exitHandler
    
    With ThisWorkbook.Sheets("py calendar")
        Dates = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
    End With
    
    Set Sh = ThisWorkbook.Sheets("Approvals")
    Set PT = Sh.PivotTables("PivotTable1")
    Set PF = PT.PivotFields("Approval Date")
    
    PT.ClearAllFilters
    
    For Each PI In PF.PivotItems
        If IsError(Application.Match(PI.Name, Dates, 0)) Then
            PI.Visible = False
        End If
    Next PI
    
    Exit Sub
    
exitHandler:
    PF.ClearAllFilters
    MsgBox "No records found!", vbExclamation

End Sub
 
Solution

sushi514

New Member
Joined
Nov 13, 2020
Messages
18
It's probably because your pivot table contains no items whose date matches a date from your list of dates. I have amended the macro to indicate when this is the case. Post back if this does not address the issue.

VBA Code:
Sub filterdates()

    Dim PT As PivotTable
    Dim PF As PivotField
    Dim PI As PivotItem
    Dim Sh As Worksheet
    Dim Dates As Variant
   
    On Error GoTo exitHandler
   
    With ThisWorkbook.Sheets("py calendar")
        Dates = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
    End With
   
    Set Sh = ThisWorkbook.Sheets("Approvals")
    Set PT = Sh.PivotTables("PivotTable1")
    Set PF = PT.PivotFields("Approval Date")
   
    PT.ClearAllFilters
   
    For Each PI In PF.PivotItems
        If IsError(Application.Match(PI.Name, Dates, 0)) Then
            PI.Visible = False
        End If
    Next PI
   
    Exit Sub
   
exitHandler:
    PF.ClearAllFilters
    MsgBox "No records found!", vbExclamation

End Sub
ah yes, thank you! I ensured the date format matched in both, and now i am receiving hits.
 

Watch MrExcel Video

Forum statistics

Threads
1,126,996
Messages
5,622,078
Members
415,875
Latest member
Tarali

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 MrExcel.com.
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 "mrexcel.com".
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
Top