Look for existing pivottables and change date/year colums based off the “Value” filter

Question

We have a macro that updates all dates/years in all our pivottables (around 100 of them pulling out data from our OLAP cube) based off of a "Master Date" at the top of our sheet (which is being updated monthly). The problem is, that the way we're doing it, takes up a lot of space, and we've been forced to split the macro into multiple subs since it started exceeding the compile limit.

As you can see in the code example, its a very primitive way of updating the dates.

The next big problem is that the "YearMonth" filter that is being used to show the year and month is different, because some PT are looking at order quantity (QtyOrdered) and some are looking at sales quantity (QtyCustPackSlip), whihch are using a separate "YearMonth" filter.

Sub UpDateAllPivots()
' UpDateAllPivots Macro, nr.1


Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'These ranges are the "Master Date
    D1 = Sheets("DATA").Range("B6").Value
    D2 = Sheets("DATA").Range("C6").Value
    D3 = Sheets("DATA").Range("D6").Value
    D4 = Sheets("DATA").Range("E6").Value
    D5 = Sheets("DATA").Range("F6").Value
    D6 = Sheets("DATA").Range("G6").Value
    D7 = Sheets("DATA").Range("H6").Value
    D8 = Sheets("DATA").Range("I6").Value
    D9 = Sheets("DATA").Range("J6").Value
    D10 = Sheets("DATA").Range("K6").Value
    D11 = Sheets("DATA").Range("L6").Value
    D12 = Sheets("DATA").Range("M6").Value

'This is a PT looking at QtyOrdered, using the Date.YearMonth
ActiveSheet.PivotTables("PivotTable1").PivotFields( _
        "[Date].[YearMonth].[YearMonth]").VisibleItemsList = Array("", _
        "[Date].[YearMonth].&[" & D1 & "]", "[Date].[YearMonth].&[" & D2 & "]", "[Date].[YearMonth].&[" & D3 & "]", _
        "[Date].[YearMonth].&[" & D4 & "]", "[Date].[YearMonth].&[" & D5 & "]", "[Date].[YearMonth].&[" & D6 & "]", _
        "[Date].[YearMonth].&[" & D7 & "]", "[Date].[YearMonth].&[" & D8 & "]", "[Date].[YearMonth].&[" & D9 & "]", _
        "[Date].[YearMonth].&[" & D10 & "]", "[Date].[YearMonth].&[" & D11 & "]", "[Date].[YearMonth].&[" & D12 & "]")


'This is a PT looking at QtyCustPackSlip, using the StatusPickedDatetimeKey
ActiveSheet.PivotTables("PivotTable3").PivotFields( _
        "[StatusPickedDatetimeKey].[YearMonth].[YearMonth]").VisibleItemsList = Array("", _
        "[StatusPickedDatetimeKey].[YearMonth].&[" & D1 & "]", "[StatusPickedDatetimeKey].[YearMonth].&[" & D2 & "]", "[StatusPickedDatetimeKey].[YearMonth].&[" & D3 & "]", _
        "[StatusPickedDatetimeKey].[YearMonth].&[" & D4 & "]", "[StatusPickedDatetimeKey].[YearMonth].&[" & D5 & "]", "[StatusPickedDatetimeKey].[YearMonth].&[" & D6 & "]", _
        "[StatusPickedDatetimeKey].[YearMonth].&[" & D7 & "]", "[StatusPickedDatetimeKey].[YearMonth].&[" & D8 & "]", "[StatusPickedDatetimeKey].[YearMonth].&[" & D9 & "]", _
        "[StatusPickedDatetimeKey].[YearMonth].&[" & D10 & "]", "[StatusPickedDatetimeKey].[YearMonth].&[" & D11 & "]", "[StatusPickedDatetimeKey].[YearMonth].&[" & D12 & "]")

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

What we ultimately want is to compress it into something that isn't as big, since we're only getting more data. You can imagine how big this is with 100+ PT's and growing.

I was wondering if you could make a loop that looks through all used rows, looking for pivottable1-pivottable(n+1), seing if it exist. If it does exist, then it goes through a switch with two cases being that it either uses QtyOrdered ot QtyCustPackSlip, and updates the .YearMonth accordingly.

Answer 1

Comepletely forgot to post an answer to this, that i found a little after asking this question. Hopefully someone can use it

The code we used before was not optimal and messy, since you had to write those six lines of code for each PT, and every time you added a new PT.

I then realised you could just add some for each ... then loops that would go through not only every PT, but also each field in the PT, and then I could add the If / elsif that would check which field each PT is using, and have it correct the dates accordingly.

I had to set the pt anme as a string pts = pt for it to recognize it as a name (I don't know why exactly), but just having it as ActiveSheet.PivotTables(pt).PivotFields( _ .... Didn't work as it thought the name was "pt" and not the actualt name like "PivotTable1"..

It works as intended, the process takes about 1 min to complete. I suspect you can make it faster, but I havn't looked at it.

Sub UpdateAllPivots_new()
'
'Looks through all pivots in the sheet and updates the dates accordingly
'
'Update time is approx. 1 min (How can this be improved)
'

Dim ws As Worksheet
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim pts As String

    D1 = Sheets("DATA").Range("B6").Value
    D2 = Sheets("DATA").Range("C6").Value
    D3 = Sheets("DATA").Range("D6").Value
    D4 = Sheets("DATA").Range("E6").Value
    D5 = Sheets("DATA").Range("F6").Value
    D6 = Sheets("DATA").Range("G6").Value
    D7 = Sheets("DATA").Range("H6").Value
    D8 = Sheets("DATA").Range("I6").Value
    D9 = Sheets("DATA").Range("J6").Value
    D10 = Sheets("DATA").Range("K6").Value
    D11 = Sheets("DATA").Range("L6").Value
    D12 = Sheets("DATA").Range("M6").Value


Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False

Set ws = ActiveSheet

    For Each pt In ws.PivotTables
    pts = pt 

        For Each pf In pt.PivotFields


                    If pf.Name = "[StatusPickedDatetimeKey].[YearMonth].[YearMonth]" Then
                         ActiveSheet.PivotTables(pts).PivotFields( _
                         "[StatusPickedDatetimeKey].[YearMonth].[YearMonth]").VisibleItemsList = Array("", _
                         "[StatusPickedDatetimeKey].[YearMonth].&[" & D1 & "]", "[StatusPickedDatetimeKey].[YearMonth].&[" & D2 & "]", "[StatusPickedDatetimeKey].[YearMonth].&[" & D3 & "]", _
                         "[StatusPickedDatetimeKey].[YearMonth].&[" & D4 & "]", "[StatusPickedDatetimeKey].[YearMonth].&[" & D5 & "]", "[StatusPickedDatetimeKey].[YearMonth].&[" & D6 & "]", _
                         "[StatusPickedDatetimeKey].[YearMonth].&[" & D7 & "]", "[StatusPickedDatetimeKey].[YearMonth].&[" & D8 & "]", "[StatusPickedDatetimeKey].[YearMonth].&[" & D9 & "]", _
                         "[StatusPickedDatetimeKey].[YearMonth].&[" & D10 & "]", "[StatusPickedDatetimeKey].[YearMonth].&[" & D11 & "]", "[StatusPickedDatetimeKey].[YearMonth].&[" & D12 & "]")

                    ElseIf pf.Name = "[Date].[YearMonth].[YearMonth]" Then
                        ActiveSheet.PivotTables(pts).PivotFields( _
                        "[Date].[YearMonth].[YearMonth]").VisibleItemsList = Array("", _
                        "[Date].[YearMonth].&[" & D1 & "]", "[Date].[YearMonth].&[" & D2 & "]", "[Date].[YearMonth].&[" & D3 & "]", _
                        "[Date].[YearMonth].&[" & D4 & "]", "[Date].[YearMonth].&[" & D5 & "]", "[Date].[YearMonth].&[" & D6 & "]", _
                        "[Date].[YearMonth].&[" & D7 & "]", "[Date].[YearMonth].&[" & D8 & "]", "[Date].[YearMonth].&[" & D9 & "]", _
                        "[Date].[YearMonth].&[" & D10 & "]", "[Date].[YearMonth].&[" & D11 & "]", "[Date].[YearMonth].&[" & D12 & "]")

                     End If


        Next pf

    Next pt


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True

End Sub
```