• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Control multiple pivot tables with cell value

R

ROB2018

New Member
Hi,
I'm not that versed in VBA, but I googled some examples and managed to combine various VBA's to get me where I need to be. However, I'm coming across an issue where one PivotTable is not refreshing depending on where I place it in the code structure.

Summary of what I'm trying to achieve:
Show Current Month and Year-to-Date for two different data tables. However, I want the user to be able to select from a drop down (created through data validation) and based on their selection the Current Month will be selected in the Pivot Table's "Month" filter and Year-to-Date will select all the prior months + Current Month.

i.e. Drop Down selection is March

The Month filter for the Current Month Pivot Table will select March
The Month Filter for the Year-to-Date Pivot Table will select January, February, and March

The beginning of the code below is to trigger the macro if a certain cell is changed (cell with the data validation). The Year-to-Date coding only reads January,February,March in order to select all those months and only scans for values and not formulas. Which is why there is a copy and paste script.

Sorry for the essay, but I figured the more info the better.

Thanks in advance for your help.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
   
    Dim KeyCells As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("D4")
   
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
          Is Nothing Then
 
'Copy A Range of Data
  Worksheets("MgrTools").Range("D1").Copy

'PasteSpecial Values Only
  Worksheets("MgrTools").Range("E1").PasteSpecial Paste:=xlPasteValues

'Clear Clipboard (removes "marching ants" around your original data set)
  Application.CutCopyMode = False
 
     
    End If
   
            If Intersect(Target, Range("E1")) Is Nothing Then Exit Sub
            If Target = vbNullString Then Exit Sub
           
            Dim pt As PivotTable
            Dim PField As PivotField
            Dim ThisMonth As String
           
            Set pt = Worksheets("MgrTools").PivotTables("MTD")
            Set Field = pt.PivotFields("MonthName")
            NewCat = Worksheets("MgrTools").Range("D4").Value

            'This updates and refreshes the PIVOT table
            With pt
            Field.ClearAllFilters
            Field.CurrentPage = NewCat
            pt.RefreshTable
            End With
           
            Set pt = Worksheets("MgrTools").PivotTables("YTD")
            Set PField = pt.PivotFields("MonthName")
            ThisMonth = Worksheets("MgrTools").Range("E1").Value
           
            Set pt = Worksheets("RAD_Ad-hoc").PivotTables("Off Premise")
            Set PField = pt.PivotFields("Month")
            ThisMonth = Worksheets("MgrTools").Range("E1").Value
           
            Set pt = Worksheets("RAD_Ad-hoc").PivotTables("Off Premise by Region")
            Set PField = pt.PivotFields("Month")
            ThisMonth = Worksheets("MgrTools").Range("E1").Value
           
            Set pt = Worksheets("RAD_Ad-hoc").PivotTables("On Premise")
            Set PField = pt.PivotFields("Month")
            ThisMonth = Worksheets("MgrTools").Range("E1").Value
           
            Set pt = Worksheets("RAD_Ad-hoc").PivotTables("On Premise by Region")
            Set PField = pt.PivotFields("Month")
            ThisMonth = Worksheets("MgrTools").Range("E1").Value
           
            Set pt = Worksheets("RAD_Ad-hoc").PivotTables("General1")
            Set PField = pt.PivotFields("Month")
            ThisMonth = Worksheets("MgrTools").Range("E1").Value
           
            Set pt = Worksheets("RAD_Ad-hoc").PivotTables("General2")
            Set PField = pt.PivotFields("Month")
            ThisMonth = Worksheets("MgrTools").Range("E1").Value
           
            Set pt = Worksheets("RAD_Ad-hoc").PivotTables("General3")
            Set PField = pt.PivotFields("Month")
            ThisMonth = Worksheets("MgrTools").Range("E1").Value
           
            Set pt = Worksheets("RAD_Ad-hoc").PivotTables("General4")
            Set PField = pt.PivotFields("Month")
            ThisMonth = Worksheets("MgrTools").Range("E1").Value

           
            On Error Resume Next
            Application.ScreenUpdating = False
            Items_Array = Split(Target, ",")
            With pt
                Application.EnableEvents = False
                With PField
                      .ClearAllFilters
                      For i = 1 To .PivotItems.Count
                          matchfound = False
                          For j = 0 To UBound(Items_Array, 1)
                              If .PivotItems(i) = Items_Array(j) Then
                                matchfound = True
                              End If
                          Next j
                          If matchfound Then .PivotItems(i).Visible = True Else .PivotItems(i).Visible = False
                      Next i
                End With
                .RefreshTable
                Application.EnableEvents = True
            End With
            On Error GoTo 0

End Sub
 
I forgot to mention which section is not updating. The YTD section is not updating if it's above the rest of the script, but will work if i drop it below the General4 script.
 
Just realized if i place the below code between the YTD section and Off Premise section everything works. If someone can help make this code more simple please feel free to chime in!!!

Code: 
On Error Resume Next
            Application.ScreenUpdating = False
            Items_Array = Split(Target, ",")
            With pt
                Application.EnableEvents = False
                With PField
                      .ClearAllFilters
                      For i = 1 To .PivotItems.Count
                          matchfound = False
                          For j = 0 To UBound(Items_Array, 1)
                              If .PivotItems(i) = Items_Array(j) Then
                                matchfound = True
                              End If
                          Next j
                          If matchfound Then .PivotItems(i).Visible = True Else .PivotItems(i).Visible = False
                      Next i
                End With
                .RefreshTable
                Application.EnableEvents = True
            End With
 
You must log in or register to reply here.
Back
Top