VBA to automatically create individual pivot tables for each row header and allow filtering by region

[ninaking]

Hello VBA Gurus,

Could really use your expertise. I'm trying to create a project schedule that can be filtered by region. The only way I found to do that was to create Pivot Tables and filter each one. I need to be able to automatically create the pivot tables and filter each caption by whatever filter critieria the user enters.

I created the following VBA but I need the PivotField names to be dynamically pulled from the table (as opposed to hard coded the way it is now) and I also need the pivot tables to be automatically created (I created these manually).

Please help!

This is the macro:
Sub changeFilterCriteria()
strName = InputBox(Prompt:="Please enter region to filter by.", _
Title:="ENTER REGION NAME", Default:="(West)")
ActiveSheet.PivotTables("PivotTable1").PivotFields("June 23 - June 29"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields("June 23 - June 29"). _
PivotFilters.Add Type:=xlCaptionContains, Value1:=strName

ActiveSheet.PivotTables("PivotTable2").PivotFields("July 7 - July 13"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable2").PivotFields("July 7 - July 13"). _
PivotFilters.Add Type:=xlCaptionContains, Value1:=strName

ActiveSheet.PivotTables("PivotTable3").PivotFields("July 14 - July 18"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable3").PivotFields("July 14 - July 18"). _
PivotFilters.Add Type:=xlCaptionContains, Value1:=strName

ActiveSheet.PivotTables("PivotTable4").PivotFields("July 21 - July 27"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("July 21 - July 27"). _
PivotFilters.Add Type:=xlCaptionContains, Value1:=strName

ActiveSheet.PivotTables("PivotTable5").PivotFields("July 28 - Aug 3"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable5").PivotFields("July 28 - Aug 3"). _
PivotFilters.Add Type:=xlCaptionContains, Value1:=strName

ActiveSheet.PivotTables("PivotTable6").PivotFields("Aug 4 - Aug 10"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable6").PivotFields("Aug 4 - Aug 10"). _
PivotFilters.Add Type:=xlCaptionContains, Value1:=strName

ActiveSheet.PivotTables("PivotTable7").PivotFields("Aug 11 - Aug 17"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable7").PivotFields("Aug 11 - Aug 17"). _
PivotFilters.Add Type:=xlCaptionContains, Value1:=strName

ActiveSheet.PivotTables("PivotTable8").PivotFields("Aug 18 - Aug 24"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable8").PivotFields("Aug 18 - Aug 24"). _
PivotFilters.Add Type:=xlCaptionContains, Value1:=strName

ActiveSheet.PivotTables("PivotTable9").PivotFields("Aug 25 - Aug 29"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable9").PivotFields("Aug 25 - Aug 29"). _
PivotFilters.Add Type:=xlCaptionContains, Value1:=strName

ActiveSheet.PivotTables("PivotTable10").PivotFields("Sep 1 - Sep 4"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable10").PivotFields("Sep 1 - Sep 4"). _
PivotFilters.Add Type:=xlCaptionContains, Value1:=strName
End Sub


And this is what the Data Source for the Pivot looks like:

Jul 7 - Jul 11		Jul 14 - Jul 18		Jul 21 - Jul 25		Jul 28 - Aug 1	4	Aug 4 - Aug 8
Develop talking points for communications		Meeting with Admin Managers (Northeast)		Meeting with Admin Managers (West)		Training (Northeast)		Training (West)
	Meeting with RVPs (Northeast)		Meeting with RVPs (West)
	Meeting with PLMs (Northeast)		Meeting with PLMs (West)
Leadership Meeting

<tbody>
</tbody><colgroup><col><col><col><col><col><col><col><col><col></colgroup>

 

[ninaking]

I forgot to put the

wrapper around the code and now it won't let me edit the post. Sorry about that!