Updating multiple pivot tables on multiple worksheets to different time ranges

Herbalgiraffe

New Member
Joined
Feb 22, 2020
Messages
16
Office Version
  1. 365
Platform
  1. Windows
Hey Y'all,

I am brand new to the forum and looking for some wisdom and advice as an ambitious new student of VBA. I am currently trying to compress the process of updating a sensitive report that is being used at my work which in total holds 29 pivot tables for all sorts of things across 15 worksheets. The pivot tables are formed from a cube of data that all share a common filter of "posting date". after failing to tie a slicer to all of them I turned to the little code I know currently. The issue is that some of the reports need to be updated as year to date, while others need to be only for the previous month, so my current thought is to declare the worksheets into two groups which are then run through two different loops of unfiltering and refiltering accordingly. Below is what I currently have, but the other challenge is that testing the filtering process by recording myself, it shows up in a format I have never seen before, which is the second chunk of code. Any wisdom you can give on how to make the two dance together would make my life a heck of a lot easier. Thanks in advance!

VBA Code:
Sub RefreshAllPivots()
    Dim wks As Worksheet
    Dim pt As PivotTable
    Dim YTD As Variant
    Dim MTD As Variant
    YTD = ActiveWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
    MTD = ActiveWorkbook.Sheets(Array("Sheet4", "Sheet5", "Sheet6"))
    
    For Each wks In YTD
        For Each pt In wks.PivotTables
            pt.PivotFields("Date").ClearAllFilters
            pt.PivotFields("Date").PivotFilters.Add Type:=xlDateBetween, _
        Value1:=CLng((Range("01/01/2020").Value)), Value2:=CLng((Range("Today's Date").Value))
        Next pt
    Next wks
    .Activate
    
    For Each wks In MTD
        For Each pt In wks.PivotTables
            pt.PivotFields("Date").ClearAllFilters
            pt.PivotFields("Date").PivotFilters.Add Type:=xlDateBetween, _
        Value1:=CLng((Range("First Date of last month").Value)), Value2:=CLng((Range("Last Date of last month").Value))
        Next pt
    Next wks
    .Activate
End Sub


VBA Code:
Sub Month1()
'
' Month1 Macro
'
' Keyboard Shortcut: Ctrl+Shift+Q
'
    ActiveSheet.PivotTables("PivotTable3").PivotFields("[Posting Date].[Date YQMD].[Year]").VisibleItemsList = Array("")
    ActiveSheet.PivotTables("PivotTable3").PivotFields("[Posting Date].[Date YQMD].[Quarter]").VisibleItemsList = Array("")
    ActiveSheet.PivotTables("PivotTable3").PivotFields("[Posting Date].[Date YQMD].[Month]").VisibleItemsList = Array("[Posting Date].[Date YQMD].[Month].&[2]&[2019]", "[Posting Date].[Date YQMD].[Month].&[2]&[2020]")
    ActiveSheet.PivotTables("PivotTable3").PivotFields("[Posting Date].[Date YQMD].[Day]").VisibleItemsList = Array("")
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Welcome to the Forum.

Your first post is a stumper since it was about to fall of the end of the 'unanswered thread' queue.

'I have not seen that bracketed stype of notation from the VBA recorder in any of my PivotTable
' work. I assume it is because you are dealing with a data cube. My best guess follows:

Code:
Sub Month1()
'
' Month1 Macro
'
' Keyboard Shortcut: Ctrl+Shift+Q
    'Clear filters from the Year field
    ActiveSheet.PivotTables("PivotTable3").PivotFields("[Posting Date].[Date YQMD].[Year]"). _
        VisibleItemsList = Array("")
    'Clear filters from the Quarter field
    ActiveSheet.PivotTables("PivotTable3").PivotFields("[Posting Date].[Date YQMD].[Quarter]"). _
        VisibleItemsList = Array("")
    'Set the parmeters for the filter in the Month field to Feb 2019 to Feb 2020
    ActiveSheet.PivotTables("PivotTable3").PivotFields("[Posting Date].[Date YQMD].[Month]"). _
        VisibleItemsList = Array("[Posting Date].[Date YQMD].[Month].&[2]&[2019]", _
            "[Posting Date].[Date YQMD].[Month].&[2]&[2020]")
    'Clear filters from the Day field
    ActiveSheet.PivotTables("PivotTable3").PivotFields("[Posting Date].[Date YQMD].[Day]"). _
        VisibleItemsList = Array("")

End Sub

'You should be able to build this format (two strings in an array)
' Array("[Posting Date].[Date YQMD].[Month].&[2]&[2019]", "[Posting Date].[Date YQMD].[Month].&[2]&[2020]")
'From your desired date range and then feed back the the strings into the code
' Array("sFirst", "sSecond")

'What (at a keystroke/mouse ops level) did you do manually to generate this line:
' ActiveSheet.PivotTables("PivotTable3").PivotFields("[Posting Date].[Date YQMD].[Month]"). _
' VisibleItemsList = Array("[Posting Date].[Date YQMD].[Month].&[2]&[2019]", _
' "[Posting Date].[Date YQMD].[Month].&[2]&[2020]")

'Before I make more guesses, could you please provide a description of your data cube fields relating
'to [Posting Date].[Date YQMD].[Month]

'When working with a 2-D pivot table, when new rows are added you have to modify the range that
'the pivot table is examining. This code is good for that:

Code:
Sub RefreshPivotTableSource()
    'XL 2007
    Dim lX As Long
    Dim sSourceSheet As String
    Dim sPivotTableSheet As String
    
    sSourceSheet = "Data"
    sPivotTableSheet = "PT"
    
    For lX = 1 To Worksheets(sPivotTableSheet).PivotTables.Count
        Worksheets(sPivotTableSheet).PivotTables(lX).ChangePivotCache _
            ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
             sSourceSheet & "!" & ActiveWorkbook.Worksheets(sSourceSheet).Range("A1"). _
             CurrentRegion.Address(ReferenceStyle:=xlR1C1), Version:=xlPivotTableVersion10)
    Next
    
End Sub


'I do not know if the cube will require refreshing as well, but I would assume so.

'Since you are a new student to VBA, let me provide you with a few painful facts:
' The recorder seldom records the most efficent way to write code
' Very rarely, but often enough to cause problems, the recorder output does not work at all.
 
Upvote 0

Forum statistics

Threads
1,214,943
Messages
6,122,369
Members
449,080
Latest member
Armadillos

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