0
votes

If it is possible please can someone provide the code that will enable me to automate the process of changing filters for week numbers on numerous pivot tables.

I produce a weekly report that requires a 10 week period range. Therefore, every week I have to remove from numerous pivot tables the Week filter that has become the 11th week and add to the Week filter the previous week.

I have provided a recorded macro version of the process and a screen shot of the table to help explain. I've tried various searches but I cannot find anything relevant. Any help that can be provided I will greatly appreciate.

Image of pivot table before filter is updated

Sub Macro2()
'
' Macro2 Macro
'
'
Range("B15").Select
ActiveSheet.PivotTables("TopPvt").PivotCache.Refresh
With ActiveSheet.PivotTables("TopPvt").PivotFields("Week")
    .PivotItems("45").Visible = False
    .PivotItems("3").Visible = True
End With
Range("B21").Select
End Sub
2

2 Answers

0
votes

Try this:

Sub Test2()

Dim firstdate As Integer, seconddate As Integer

seconddate = Format(Date, "ww") - 1
firstdate = Format(Date - 84, "ww") - 1

Range("B15").Select
ActiveSheet.PivotTables("TopPvt").PivotCache.Refresh
With ActiveSheet.PivotTables("TopPvt").PivotFields("Week")
    .PivotItems(firstdate).Visible = False
    .PivotItems(seconddate).Visible = True
End With
Range("B21").Select

End Sub
0
votes

This code is the solution to my question. Thanks to Taccoo73 and a bit of tweaking on my part I was able to get the code to work how I needed it to.

The week numbers, e.g. 47 to 4 need to be put in specified cells. So, 47 needs to be put in "c4", 52 in "d4", 1 to be put in "e4", 4 to be put in "f4".

Sub test150()

Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim begin As Integer
Dim finish As Integer
Dim begintwo As Integer
Dim finishtwo As Integer


On Error GoTo Err
begin = Range("c4")
finish = Range("d4")
begintwo = Range("e4")
finishtwo = Range("f4")


For Each pt In ActiveSheet.PivotTables


Set pf = pt.PivotFields("Week")


    pf.EnableMultiplePageItems = True

For Each pi In pf.PivotItems

    pi.Visible = pi >= begin And pi <= finish Or pi >= begintwo And pi <= finishtwo

Next pi
Next pt


Err:
Resume Next

MsgBox "Finished"

End Sub