Updating Pivotfields from a Data Validation list across multiple Pivot Tables on Multiple sheets

Carpenter447

New Member
Joined
Mar 5, 2012
Messages
10
Hello I have an issue that i have been playing around with my self for quite sometime now. I found a code that should work but for some reason it is not working and I haven't a clue why. Any help would be appreciated.

Goal : Code that will take a drop list and modify the pivot filters on multiple pivot tables on multiple sheets simultaneously. I.e. Drop list selection is Brown; Brown is part of the Filter Colors; All subsequent pivot tables with the same Filter for colors would then switch to brown and update the data within it.

Issue : The coding works on a sample set that I ripped from contexures.com but not for my data as it stands now.

Additional Info : I am running Excel 2007, I import that data within my pivots from an OLAP cube, & even though I work with macros quite often my actual verbatim writing skills are limited.

So the code below is an adapted version of what you can find on contextures website. I want to be able change three unique Pivot Fields simultaneously. The code string is simply triplicated below with the different fields inputted. When I use the initial code from contexture.com it works but then when i change the Pivotfield nothing happens.

Code:
Sub UpdatePivotFields()
Dim ws As Worksheet
Dim pt As PivotTable
Dim pi As PivotItem
Dim strField1 As String
Dim strField2 As String
Dim strField3 As String

On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False

'This sector changes strField1 or "Top Customer Name US"
strField1 = "Top Customer Name US"
    If Target.Address = Range("D2").Address Then
        For Each ws In ThisWorkbook.Worksheets
            For Each pt In ws.PivotTables
                With pt.PageFields(strField1)
                    For Each pi In .PivotItems
                        If pi.Value = Target.Value Then
                            .CurrentPage = Target.Value
                            Exit For
                        Else
                            .CurrentPage = "(All)"
                        End If
                    Next pi
                End With
            Next pt
        Next ws
    End If

'This sector changes strField2 or "_Plant"
strField2 = "_Plant"
    If Target.Address = Range("M2").Address Then
        For Each ws In ThisWorkbook.Worksheets
            For Each pt In ws.PivotTables
                With pt.PageFields(strField1)
                    For Each pi In .PivotItems
                        If pi.Value = Target.Value Then
                            .CurrentPage = Target.Value
                            Exit For
                        Else
                            .CurrentPage = "(All)"
                        End If
                    Next pi
                End With
            Next pt
        Next ws
    End If

'This sector changes strField3 or "Month"
strField3 = "Month"
    If Target.Address = Range("U2").Address Then
        For Each ws In ThisWorkbook.Worksheets
            For Each pt In ws.PivotTables
                With pt.PageFields(strField1)
                    For Each pi In .PivotItems
                        If pi.Value = Target.Value Then
                            .CurrentPage = Target.Value
                            Exit For
                        Else
                            .CurrentPage = "(All)"
                        End If
                    Next pi
                End With
            Next pt
        Next ws
    End If
End Sub
 
Below is some code you can try. I'm not able to fully test it without the datasource- so it might need some tweaking.

To use the code (always test new code on a copy of your workbook):
1. Right Click on the Tab of your Sheet that has the Data Validation dropdowns
2. Select View Code...
3. Copy and Paste the Sub Worksheet_Change Code below into the Sheet Code module.

Rich (BB code):
Private Sub Worksheet_Change(ByVal Target As Range)
'---When any of DV Dropdowns is changed, sets CurrentPageName
'      of corresponding PivotField for all listed PivotTables.

    Dim sDV_Addr1 As String, sDV_Addr2 As String, sDV_Addr3 As String
    Dim sField As String, sPage As String, i As Long
    Dim PT As PivotTable, vPTNames As Variant
   
    sDV_Addr1 = "$D$2" 'Top Customer DV Cell
    sDV_Addr2 = "$M$2" 'Plant
    sDV_Addr3 = "$U$2" 'Month
    
    '---Make list of PTs to be Filtered
    vPTNames = Array("PivotTable1", "PivotTable2", _
        "PivotTable3", "PivotTable7")
  
    With ActiveSheet
        If Intersect(Target, Range(sDV_Addr1 & "," & _
            sDV_Addr2 & "," & sDV_Addr3)) Is Nothing Or _
            Target.Cells.Count > 1 Then Exit Sub
        
        '---Set Parameters based on DV Cell changed
        Select Case Target.Address
            Case sDV_Addr1
                sField = "[TopCustomersUS].[Top Customer Name US]." & _
                    "[Top Customer Name US]"
                sPage = "[TopCustomersUS].[Top Customer Name US].&[" _
                    & Target & "]"
            Case sDV_Addr2
                sField = "[Plant].[_Plant].[_Plant]"
                sPage = "[Plant].[_Plant].&[" & Target & "]"
            Case sDV_Addr3
                sField = "[Time].[Month].[Month]"
                sPage = "[Time].[Month].&[" & Target & "]"
            Case Else:
                MsgBox "Error in Worksheet_Change"
                Exit Sub
        End Select
        
        On Error GoTo CleanUp
        Application.EnableEvents = False
    
        '---Filter each PT in list using Parameters
        For i = LBound(vPTNames) To UBound(vPTNames)
            '---for Testing
            Debug.Print "Setting PT:" & vPTNames(i) & _
                "  Field:" & sField & "   Page:" & sPage
            Set PT = .PivotTables(vPTNames(i))
            With PT.PivotFields(sField)
                .ClearAllFilters
                .CurrentPageName = sPage
            End With
        Next i
    End With
       
CleanUp:
    Application.EnableEvents = True
End Sub

EDIT: The code assumes all the PivotTables being processed are on the same Worksheet as the DV Cells.
If that isn't the case, the code can be modified to work with multiple sheets.
 
Last edited:
Upvote 0

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.
The code seems to stop at the spot below with an object required error:
Code:
With ActiveSheet
        If Intersect(Target, Range(sDV_Addr1 & "," & _
            sDV_Addr2 & "," & sDV_Addr3)) Is Nothing Or _
            Target.Cells.Count > 1 Then Exit Sub
        
        '---Set Parameters based on DV Cell changed
        Select Case Target.Address

Also per your note, the data validation lists are in one sheet which has the pivot charts but all the pivot tables that run the pivot charts are on multiple other sheets. Any help on this would be appreciated!
 
Upvote 0
The code seems to stop at the spot below with an object required error:
Code:
With ActiveSheet
        If Intersect(Target, Range(sDV_Addr1 & "," & _
            sDV_Addr2 & "," & sDV_Addr3)) Is Nothing Or _
            Target.Cells.Count > 1 Then Exit Sub
        
        '---Set Parameters based on DV Cell changed
        Select Case Target.Address

Also per your note, the data validation lists are in one sheet which has the pivot charts but all the pivot tables that run the pivot charts are on multiple other sheets. Any help on this would be appreciated!

Please post your entire Worksheet_Change Procedure so it will be easier to diagnose the cause of the error. (or let me know if you have made no modifications to what I posted).

For each PivotTable that you want to update, if you'll post the Sheet Name and PivotTable name, I'll suggest a modification to the code.
 
Last edited:
Upvote 0
JS411 -

I saw your code in Post #11 and it is almost what I need. You mentioned it can be adjusted to work on PivotTables in multiple worksheets.

What would I need to change?

------------------------------------------

A little about my dilema.

Sheet1 = Summary Sheet (Multiple Data Validation dropdowns which would change the pivot tables in the other sheets)

- Contains Charts and tables that linked to the pivot tables in Sheet2 through Sheet4.

I was using the below to change a pivot with a DV dropdown in the same sheet.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Address = "$C$5" Then
        ActiveSheet.PivotTables("PivotTable2").PivotFields("Geography").CurrentPage = Target.Value
    End If
    If Target.Address = "$C$6" Then
        ActiveSheet.PivotTables("PivotTable2").PivotFields("Time").CurrentPage = Target.Value
    End If

End Sub

Then I had Data Validations on sheet1 that would change the DVs on Sheet2 through Sheet4, but then the code above wouldn't change my pivot tables.

Any help would be appreciated.

turtle
 
Upvote 0
Hi turtle,

I'll try to help. In the quote below, do you really mean that the DVs on Sheet1 change the DVs on Sheet2 through Sheet4, or did you mean the PivotTables on Sheet2 through Sheet4? If so please explain.

Then I had Data Validations on sheet1 that would change the DVs on Sheet2 through Sheet4, but then the code above wouldn't change my pivot tables.
 
Last edited:
Upvote 0
Yes. The DVs on Sheet1 change the DVs on Sheet2 through Sheet4. This isn't necessary and I consider it redundant.

Hi turtle,

I'll try to help. In the quote below, do you really mean that the DVs on Sheet1 change the DVs on Sheet2 through Sheet4, or did you mean the PivotTables on Sheet2 through Sheet4? If so please explain.


I think that I can use your code in Post#11. I just would need to understand how to change it so the DVs from Sheet1 change the PivotTables in Sheet2 through Sheet4.


turtle
 
Upvote 0
Turtle,

Here's some revised code that allows you to specify a list of PivotTables on different sheets
using the format SheetName!PivotTableName

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR="Teal"]'---When any of DV Dropdowns is changed, sets CurrentPage
'      of corresponding PivotField for all listed PivotTables.[/COLOR]

    Dim sDV_Addr1 As String, sDV_Addr2 As String, sField As String
    Dim i As Long, PT As PivotTable
    Dim vPTNames As Variant, vPTName As Variant
   
    sDV_Addr1 = "$C$5" [COLOR="Teal"]'Geography DV Cell[/COLOR]
    sDV_Addr2 = "$C$6" [COLOR="teal"]'Time[/COLOR]
   
[COLOR="teal"]    '---Make list of PTs to be Filtered[/COLOR]
    vPTNames = Array("Sheet1!PivotTable2", "Sheet2!PivotTable4", _
        "Sheet3!PivotTable1", "Sheet4!PivotTable6")
        
    If Intersect(Target, Range(sDV_Addr1 & "," & _
        sDV_Addr2)) Is Nothing Or _
        Target.Cells.Count > 1 Then Exit Sub
    
[COLOR="teal"]    '---Set Field based on DV Cell changed[/COLOR]
    Select Case Target.Address
        Case sDV_Addr1
            sField = "Geography"
        Case sDV_Addr2
            sField = "Time"
        Case Else:
            MsgBox "Error in Worksheet_Change"
            Exit Sub
    End Select
    
    On Error GoTo CleanUp
    Application.EnableEvents = False

[COLOR="teal"]    '---Filter each PT in list using Parameters[/COLOR]
    For i = LBound(vPTNames) To UBound(vPTNames)
        vPTName = Split(vPTNames(i), "!")
        Set PT = Sheets(vPTName(0)).PivotTables(vPTName(1))
        With PT.PivotFields(sField)
            .ClearAllFilters
            .CurrentPage = Target.Text
        End With
    Next i
       
CleanUp:
    Application.EnableEvents = True
End Sub
 
Last edited:
Upvote 0
Please post your entire Worksheet_Change Procedure so it will be easier to diagnose the cause of the error. (or let me know if you have made no modifications to what I posted).

For each PivotTable that you want to update, if you'll post the Sheet Name and PivotTable name, I'll suggest a modification to the code.

Sorry for the long lag in response...

Here are the breakdowns for my pivot tables the "" are not part of the string:

Sheet Name "Casefill"
Pivot Names:
  • "PivotTopLeft"
  • "PivotTopCenter"

Sheet Name "On Time"
Pivot Names:
  • "PivotBottomRight1"
  • "PivotBottomRight2"

Sheet Name "ATP Cut"
Pivot Names:
  • "PivotTopRight1"
  • "PivotTopRight2"
  • "PivotBottomLeft1"
  • "PivotBottomLeft2"

Hopefully this helps get us going again.
 
Upvote 0
Here are the breakdowns for my pivot tables the "" are not part of the string:
...snip...

Hopefully this helps get us going again.

Hi again,

You could try the code below.
Make sure to copy it into the Sheet Code Module of the Sheet that has the 3 DV cells (don't copy it to a Standard Code Module).

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR="teal"]'---When any of DV Dropdowns is changed, sets CurrentPageName
'      of corresponding PivotField for all listed PivotTables.[/COLOR]

    Dim sDV_Addr1 As String, sDV_Addr2 As String, sDV_Addr3 As String
    Dim sField As String, sPage As String, i As Long
    Dim PT As PivotTable
    Dim vPTNames As Variant, vPTName As Variant
   
    sDV_Addr1 = "$D$2" [COLOR="Teal"]'Top Customer DV Cell[/COLOR]
    sDV_Addr2 = "$M$2" [COLOR="teal"]'Plant[/COLOR]
    sDV_Addr3 = "$U$2" [COLOR="teal"]'Month[/COLOR]
    
[COLOR="teal"]    '---Make list of PTs to be Filtered[/COLOR]
    vPTNames = Array("Casefill!PivotTopLeft", "Casefill!PivotTopCenter", _
        "On Time!PivotBottomRight1", "On Time!PivotBottomRight2", _
        "ATP Cut!PivotTopRight1", "ATP Cut!PivotTopRight2", _
        "ATP Cut!PivotBottomLeft1", "ATP Cut!PivotBottomLeft2")
     
    If Intersect(Target, Range(sDV_Addr1 & "," & _
        sDV_Addr2 & "," & sDV_Addr3)) Is Nothing Or _
        Target.Cells.Count > 1 Then Exit Sub
    
[COLOR="teal"]    '---Set Parameters based on DV Cell changed[/COLOR]
    Select Case Target.Address
        Case sDV_Addr1
            sField = "[TopCustomersUS].[Top Customer Name US]." & _
                "[Top Customer Name US]"
            sPage = "[TopCustomersUS].[Top Customer Name US].&[" _
                & Target & "]"
        Case sDV_Addr2
            sField = "[Plant].[_Plant].[_Plant]"
            sPage = "[Plant].[_Plant].&[" & Target & "]"
        Case sDV_Addr3
            sField = "[Time].[Month].[Month]"
            sPage = "[Time].[Month].&[" & Target & "]"
        Case Else:
            MsgBox "Error in Worksheet_Change"
            Exit Sub
    End Select
        
    On Error GoTo CleanUp
    Application.EnableEvents = False
    
[COLOR="teal"]   '---Filter each PT in list using Parameters[/COLOR]
    For i = LBound(vPTNames) To UBound(vPTNames)
[COLOR="teal"]        '---for Testing[/COLOR]
        Debug.Print "Setting Sheet!PT:" & vPTNames(i) & _
                "  Field:" & sField & "   Page:" & sPage
        vPTName = Split(vPTNames(i), "!")
        Set PT = Sheets(vPTName(0)).PivotTables(vPTName(1))
        With PT.PivotFields(sField)
            .ClearAllFilters
            .CurrentPage = Target.Text
        End With
    Next i
       
CleanUp:
    Application.EnableEvents = True
End Sub

I'm not able to test this since I don't have the OLAP data source, but the Debug.Print strings being sent to the Immediate Window seem to be working as intended.
 
Upvote 0

Forum statistics

Threads
1,221,476
Messages
6,160,058
Members
451,615
Latest member
soroosh

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