Updating multiple pivot tables on multiple worksheets to different time ranges

Herbalgiraffe

New Member
Joined
Feb 22, 2020
Messages
11
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("")
 

Some videos you may like

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,848
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,114,019
Messages
5,545,523
Members
410,689
Latest member
ConfuzzledThomas
Top