VBA help to update pivottable date filter with a single cell value date

Mary2012

New Member
Joined
Jan 5, 2012
Messages
5
My first post....

I have a single worksheet with multiple pivot tables. They all have a date range filter. I want to insert vba code that will change the date filter for all the pivot tables on the sheet when I change a date in a single cell on the same sheet.

I am using Excel 2007 on Windows XP. I am pretty new to pivot tables, as well as VBA, but I'm learning quickly. The pivot tables I am working with have been inherited, so I didn't create them myself.

I've tried a few solutions I've found here and on the net, but they all vary greatly and didn't work. So I thought I'd start from scratch here.

Any suggestions? It seems this should be simple using pivotfilters.add type, but I'm stuck.

Thanks.
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Hi Mary and Welcome to the Board,

This thread has example code that should do what you describe.

http://www.mrexcel.com/forum/showthread.php?t=596418

PivotFilters.Add works a little differently. Instead of making individual PivotItems Visible or Hidden, it uses a criteria string. That function would be a better fit if you wanted all dates after a specified date, or between a pair of dates.

Just ask if you need any help adapting the code for your purpose.
 
Upvote 0
Wow, that worked great! Thanks so much. I would never have been able to create that.

Question....

So I added to the vba code extra statements to have the same one cell date inserted as the filter to different date fields in four different pivot tables on the sheet. I need to go further with the same code to include around 50 different pivot tables in the sheet, all with different filter date fields, which all need to be changed to the date that's in cell B1.

The code is below. I changed it to include 4 pivot tables, each with a different date field name. Is there an easier way to do this, rather than adding dim statements for all 50 date fields, field name definitions, then call filter statements for each pivot table and field? Is there a way to combine these three tasks into one statement per pivot table?

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim aField As String
    Dim bField As String
    Dim cfield As String
    Dim dfield As String
    Dim sDV_Address As String
    Dim ptTables As PivotTables
 
    aField = "Shipped Date"  'Field Name
    bField = "Image Audit Date"  'Field Name
    cfield = "Imaged Date"  'Field Name
    dfield = "QC Date"  'Field Name
    sDV_Address = "B1" 'Cell with date to select filter item.
    With ActiveSheet
        If Intersect(Target, Range(sDV_Address)) Is Nothing Or _
            Target.Cells.Count > 1 Then Exit Sub
 
        On Error GoTo CleanUp
        Application.EnableEvents = False
 
        Call Filter_PivotField( _
            pvtField:=.PivotTables("PivotTable46").PivotFields(aField), _
                vItems:=Target.Value)
        Call Filter_PivotField( _
            pvtField:=.PivotTables("PivotTable47").PivotFields(bField), _
                vItems:=Target.Value)
        Call Filter_PivotField( _
            pvtField:=.PivotTables("PivotTable48").PivotFields(cfield), _
                vItems:=Target.Value)
        Call Filter_PivotField( _
            pvtField:=.PivotTables("PivotTable49").PivotFields(dfield), _
                vItems:=Target.Value)
    End With
 
CleanUp:
    Application.EnableEvents = True
End Sub

Thanks so much!
 
Upvote 0
Maybe something like this that steps through an Array of PivotTable names and associated Fields.

This is untested, but it will give you an idea of one approach.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sDV_Address As String
    Dim ptTables As PivotTables
    Dim vFields As Variant, vPTNumbers As Variant
    Dim i As Long
      
    vPTNumbers = Array("46", "47", "48", "49")
    
    vFields = Array("Shipped Date", "Image Audit Date", _
                    "Imaged Date", "QC Date")
  
    sDV_Address = "B1" 'Cell with date to select filter item.
    With ActiveSheet
        If Intersect(Target, Range(sDV_Address)) Is Nothing Or _
            Target.Cells.Count > 1 Then Exit Sub
 
        On Error GoTo CleanUp
        Application.EnableEvents = False
 
        For i = LBound(vPTNumbers) To UBound(vPTNumbers)
            Debug.Print vPTNumbers(i) & " --> " & vFields(i) 'for testing
            Call Filter_PivotField( _
                pvtField:=.PivotTables("PivotTable" & vPTNumbers(i)) _
                    .PivotFields(vFields(i)), _
                    vItems:=Target.Value)
        Next i
    End With
 
CleanUp:
    Application.EnableEvents = True
End Sub

As an alternative to coding the Variant Array values into the VBA procedure,
you might find it easier to maintain if you make a table in your worksheet that has all the pairs side-by-side.
This procedure could be modified to read in the values in that table range.
 
Upvote 0
I agree with you...a separate table on the sheet would be better, cleaner. So how would the code be modified to remove the array and have it point to the pivot table/date field table?
 
Upvote 0
I agree with you...a separate table on the sheet would be better, cleaner. So how would the code be modified to remove the array and have it point to the pivot table/date field table?

You could try this. I assumes you have a range named "FieldTable" on Sheet1 with that range having PivotTable Numbers in the first column, and
Field Names in the second. The range should not include any headers.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim sDV_Address As String
    Dim vFieldTable() As Variant
    Dim i As Long
  
    sDV_Address = "B1" 'Cell with date to select filter item.
    With ActiveSheet
        If Intersect(Target, Range(sDV_Address)) Is Nothing Or _
            Target.Cells.Count > 1 Then Exit Sub
 
        On Error GoTo CleanUp
        Application.EnableEvents = False
        
        vFieldTable = Application.Transpose(Sheets("Sheet1") _
            .Range("FieldTable"))
 
        For i = LBound(vFieldTable, 2) To UBound(vFieldTable, 2)
            Call Filter_PivotField( _
                pvtField:=.PivotTables("PivotTable" & vFieldTable(1, i)) _
                    .PivotFields(vFieldTable(2, i)), _
                    vItems:=Target.Value)
        Next i
    End With
 
CleanUp:
    Application.EnableEvents = True
End Sub
 
Upvote 0
This looks great. So with this new code, do I need to make any changes to the public function filter (Filter_PivotField) in Module 1, which I added with the original code you gave me?
 
Upvote 0
You are awesome! Thanks so much for your help! It took me a while to build the pivot table list - we have about 130 pivot tables on the sheet - but once I had everything in place it worked like a charm. I'm new on the job and scored a few points with my new co-workers, plus I learned a lot in the process. Thanks again!
 
Upvote 0

Forum statistics

Threads
1,223,230
Messages
6,170,883
Members
452,364
Latest member
springate

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
Back
Top