Hi Reader,
I do have a huge chunk of data, from which I need to generate weekly report comprising of some 72 Tabs...all tabs are similar and their source data is same, only difference that they all have is on their pivot filters. My goal is to generate pivot for them and then simply copy-paste job to generate 72 reports. Below given are the codes, which I've written, and except 2 problem areas it's running fine. Problem areas are highlighted (see bold codes) in the below code with appropriate comments.

If anyone of you can help me fix my filters I would then be able to automate large chunk of lengthy work that every week I'm doing. I'm very new to Macro and with my limited knowledge I'm not able to fix the issues here. Please help.

Also let me know if you need any additional details.



Sub MakePivotTable_Tab1_Ovrdue_Qual()
Dim pt As PivotTable
Dim strField As String
Dim WSD As Worksheet
Set WSD = Worksheets("Sheet1")
Dim PTOutput As Worksheet
Set PTOutput = Worksheets("Sheet2")
Dim PTCache As PivotCache
Dim PRange As Range
Dim PI As PivotItem
Dim s As Variant
s = Date


' Find the last row with data
Dim finalRow As Long
finalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row

' Find the last column with data
Dim finalCol As Long
finalCol = WSD.Cells(1, Application.Columns.Count).End(xlToLeft).Column

' Find the range of the data
Set PRange = WSD.Cells(1, 1).Resize(finalRow, finalCol)
Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange)

' Create the pivot table
Set pt = PTCache.CreatePivotTable(TableDestination:=PTOutput.Cells(7, 1), TableName:="SamplePivot")

' Define the layout of the pivot table

' Set update to manual to avoid recomputation while laying out
pt.ManualUpdate = True

' Set up the row fields
' pt.AddFields RowFields:=Array("Process Area", "Unique Role ID", "Projects Names", "Role and Sub Role"), PageFields:=Array("DOP Resource Status")

With pt
.PivotFields("Process Area").Orientation = xlRowField
.PivotFields("Unique Role ID").Orientation = xlRowField
.PivotFields("Projects Names").Orientation = xlRowField
.PivotFields("Role and Sub Role").Orientation = xlRowField
.PivotFields("Employment Type").Orientation = xlRowField
.PivotFields("Requested Name").Orientation = xlRowField
.PivotFields("Location Role").Orientation = xlRowField
.PivotFields("Role Description").Orientation = xlRowField
.PivotFields("Project Description").Orientation = xlRowField
.PivotFields("Request Status").Orientation = xlRowField
.PivotFields("Resource Name").Orientation = xlRowField
.PivotFields("Booking Condition").Orientation = xlRowField
.PivotFields("Request Manager").Orientation = xlRowField
.PivotFields("Task Start").Orientation = xlRowField
.PivotFields("Task Finish").Orientation = xlRowField
.PivotFields("DOP Resource Status").Orientation = xlPageField
.PivotFields("Week Commencing").Orientation = xlColumnField
End With

' removing subtotals in all the columns.

Range("A7").Select
pt.PivotFields("Process Area").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("B7").Select
pt.PivotFields("Unique Role ID").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("C7").Select
pt.PivotFields("Projects Names").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("D7").Select
pt.PivotFields("Role and Sub Role").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("E7").Select
pt.PivotFields("Employment Type").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("F7").Select
pt.PivotFields("Requested Name").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("G7").Select
pt.PivotFields("Location Role").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("H7").Select
pt.PivotFields("Role Description").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("I7").Select
pt.PivotFields("Project Description").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("J7").Select
pt.PivotFields("Request Status").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("K7").Select
pt.PivotFields("Resource Name").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("L7").Select
pt.PivotFields("Booking Condition").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("M7").Select
pt.PivotFields("Request Manager").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("N7").Select
pt.PivotFields("Task Start").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("O7").Select
pt.PivotFields("Task Finish").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
Range("P7").Select
pt.PivotFields("Week Commencing").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)

' This filter is working fine, but same thing is not working for other filters

With pt.PivotFields("DOP Resource Status").CurrentPage = "(All)"
pt.PivotFields("DOP Resource Status").PivotItems("Other - please provide details in comments field").Visible = False
pt.PivotFields("DOP Resource Status").PivotItems("(blank)").Visible = False
pt.PivotFields("DOP Resource Status").EnableMultiplePageItems = True
End With

' below column filter is not working for me !!!, not sure why (this column has 72 values, I need just 2 as seen below

For Each PI In pt.PivotFields("Process Area")
Select Case PI.Name
Case "Development - Technical Environment", "ISDC Tech Services - Environment Services"
Case Else
PI.Visible = False
End Select
Next PI

' below code to apply date filter based on current/system date si not working

With pt
.PivotFields ("Task Start")
.ClearAllFilters
.PivotFilters.Add Type:=xlBefore, Value1:=s
End With

' calc the pivot table
pt.ManualUpdate = False


End Sub