Excel 2007 Pivots Query

[brendanolear]

I have a workbook that contains one sheet of data - covers 40000 rows and 80 columns.

I have numerous additional sheets within the workbook that contain pivots. All pivots were created from one original pivot and therefore all auto update by refreshing any one pivot.

Problem is, some pivots are for annual figures, some are for Monthly and some are for Weekly.

I have weekly "filters" within certain pivots and I have to manually reset these on a weekly basis, similarly with the Monthly.

How should I change my approach to enable all weekly filters to be amended by entering one week number in a "Selected" cell.

Trust this makes sense!!

 

[pbornemeier]

I believe this will do what you are describing:

Option Explicit
 
Sub ChangeDisplayedPivotTableWeekAndMonth()
    Dim wks As Worksheet
    Dim pvt As PivotTable
    Dim pfield As PivotField
    Dim pitem As PivotItem
    Dim iPTCount As Integer
 
    Dim iTargetWeek As Integer
    Dim iTargetMonth As Integer
 
    Dim bfound As Boolean
 
    iTargetWeek = 9
    iTargetMonth = 4
 
 
    Application.ScreenUpdating = False
    For Each wks In ThisWorkbook.Worksheets 'look at each worksheet
        For Each pvt In wks.PivotTables 'each pivot table on 1 worksheet
            iPTCount = iPTCount + 1
            Application.StatusBar = "Worksheet " & wks.Name & ", Working Pivot Table #" & iPTCount
            For Each pfield In pvt.VisibleFields 'each visible pivot field in 1 pivot table
                Select Case pfield.Name 'in the field you want to set
                Case "Week #" 'Week # Column Header
                    bfound = False
                    For Each pitem In pfield.PivotItems
                        If pitem.Value = iTargetWeek Then
                            bfound = True
                            pitem.Visible = True
                            Exit For
                        End If
                    Next
                        If bfound Then
                            For Each pitem In pfield.PivotItems
                                Select Case pitem.Name
                                Case iTargetWeek
                                    'do nothing
                                Case Else
                                    pitem.Visible = False
                                End Select
                            Next
                        End If
                Case "Month #" 'Month Number Column Header
                    bfound = False
                    For Each pitem In pfield.PivotItems
                        If pitem.Value = iTargetMonth Then
                            bfound = True
                            pitem.Visible = True
                            Exit For
                        End If
                    Next
                        If bfound Then
                            For Each pitem In pfield.PivotItems
                                Select Case pitem.Name
                                Case iTargetMonth
                                    'do nothing
                                Case Else
                                    pitem.Visible = False
                                End Select
                            Next
                        End If
                Case Else
 
                End Select
            Next
        Next
    Next
 
    Application.ScreenUpdating = True
    Application.StatusBar = False
 
End Sub