VBA solution for moving pivot table filter range for week numbers

[Dobo_Bobo]

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 as I am currently learning VBA.

Image: https://imgur.com/a/gYx4j

<code>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</code>

 

[taccoo73]

Hi Dobo;

Without having your workbook it's little bit hard for me to give you the exact answer, but I have something similar I'm using for similar situation.

Code below, when the date in cell D1 is chnaged, sets the filter of the pivot table to the date given in cell D1 and then refreshes the pivot table;

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

On Error GoTo Err
If Intersect(Target, Range("D2")) Is Nothing Then Exit Sub


Dim pt1 As PivotTable
Dim Field1 As PivotField
Dim NewCat1 As Date


Set pt1 = Worksheets("Daily Report").PivotTables("PivotTable4")
Set Field1 = pt1.PivotFields("DATE")
NewCat1 = Worksheets("Daily Report").Range("D1").Value


With pt1
Field1.ClearAllFilters
Field1.CurrentPage = NewCat1
pt1.RefreshTable
End With


Err:
Exit Sub


End Sub

Hope this helps.

 

[Dobo_Bobo]

Hi Taccoo

Thank you for taking the time to help me.

I've tried your code but I cannot get it to work due to Error 424. I've taken a screen shot so you can see what I mean:

https://imgur.com/buhNxGx

Can you see anywhere I have amended the code incorrectly? (I took out the 'Err' in order to see what the error is for me.)

I am not sure if it makes a difference but the week numbers are created using WEEKNUM function, thus are they seen as dates?

 

[taccoo73]

Hi Dobo;

Please try;

Sub test()

Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim begin As Long
Dim finish As Long


On Error GoTo Err
begin = Range("c1")
finish = Range("d1")


Set pt = Sheets("Pivot").PivotTables("PivotTable1")
Set pf = pt.PivotFields("Week")


pf.ClearAllFilters
pf.EnableMultiplePageItems = True


For Each pi In pf.PivotItems
    pi.Visible = pi >= begin And pi <= finish
Next pi

pt.RefreshTable

Err:
Resume Next


End Sub

Cell C1 will be the beginning week number of your report and cell D1 will be the ending week of your report.

Regards

 

[Dobo_Bobo]

Hi Taccoo

It works!! Thank you for your help! Your code will free up a lot of time which I can now use to learn VBA! I know a little VBA but having a macro that works will help me learn even more!

Thank you!

 

[taccoo73]

No worries Dobo, happy to help