VBA code to generate Pivot Table in Excel 2010

Question

I have a workbook which will be updated every week. the worksheet (named W1715.2) is huge with range A1 to AN1813 (as of this week) and the range is subject to change every week.

I want to generate a pivot table using this data:

column label as "LT Verification - Planned Week Numbers" (this is a column name in worksheet)

row label as "LT verification responsible" (this is also a column name in worksheet)

values as count of "ID" (this is also a column name in worksheet)

report filter by "Build" and "Current status" and "Type of issue"

I have a written a code shown below but it only creates a new worksheet with name PivotTable but it does not give me any pivot table! Also, the code does not include report filter since I do not know how to do it!

Here, I am looking for help to generate a pivot table with the before mentioned requirements.

1) Find the range dynamically as it is changing every week.

2) Pivot Table with the respective column, row labels and report filters and count of value.

3) The pivot table should be on a new worksheet every week

Please have a look at the code below:

Public Sub Create_Pivot_Table() Dim PSheet As Worksheet Dim DSheet As Worksheet Dim PCache As PivotCache Dim PTable As PivotTable Dim PRange As Range Dim LastRow As Long Dim LastCol As Long 'Delete Preivous Pivot Table Worksheet & Insert a New Blank Worksheet With Same Name On Error Resume Next Application.DisplayAlerts = False Worksheets("PivotTable").Delete Sheets.Add Before:=ActiveSheet ActiveSheet.Name = "PivotTable" Application.DisplayAlerts = True Set PSheet = Worksheets("PivotTable") Set DSheet = Worksheets("W1715.2") 'Define Data Range LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol) 'Define Pivot Cache Set PCache = ActiveWorkbook.PivotCaches.Create _ (SourceType:=xlDatabase, SourceData:=PRange). _ CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _ TableName:="PRIMEPivotTable") 'Insert Blank Pivot Table Set PTable = PCache.CreatePivotTable_(TableDestination:=PSheet.Cells(1, 1), TableName:="PRIMEPivotTable") 'Insert Row Fields With ActiveSheet.PivotTables("PRIMEPivotTable").PivotFields("LT verification responsible") .Orientation = xlRowField .Position = 1 End With 'Insert Column Fields With ActiveSheet.PivotTables("PRIMEPivotTable").PivotFields("LT Verification - Planned Week Numbers") .Orientation = xlColumnField .Position = 1 End With 'Insert Data Field With ActiveSheet.PivotTables("PRIMEPivotTable").PivotFields("ID") .Orientation = xlDataField .Position = 1 .Function = xlCount .Name = "Names" End With 'Format Pivot Table ActiveSheet.PivotTables("PRIMEPivotTable").ShowTableStyleRowStripes = True ActiveSheet.PivotTables("PRIMEPivotTable").TableStyle2 = "PivotStyleMedium9" End Sub

I have also included the image of the final pivot table that I wish to have. (I have applied the report filters, hence the small pivot table or else it is very huge)

Subodh Tiwari sktneer · Accepted Answer · 2017-04-12 06:09:19Z

Try it like this...

Public Sub Create_Pivot_Table() Dim PSheet As Worksheet Dim DSheet As Worksheet Dim PCache As PivotCache Dim PTable As PivotTable Dim PRange As Range Dim LastRow As Long Dim LastCol As Long Application.ScreenUpdating = False 'Delete Preivous Pivot Table Worksheet & Insert a New Blank Worksheet With Same Name On Error Resume Next Application.DisplayAlerts = False Worksheets("PivotTable").Delete Sheets.Add Before:=ActiveSheet ActiveSheet.Name = "PivotTable" Application.DisplayAlerts = True Set PSheet = Worksheets("PivotTable") Set DSheet = Worksheets("W1715.2") 'Define Data Range LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column 'Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol) Set PRange = DSheet.Range("A1").CurrentRegion 'Define Pivot Cache Set PCache = ActiveWorkbook.PivotCaches.Create _ (SourceType:=xlDatabase, SourceData:=PRange) '. _ 'CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _ 'TableName:="PRIMEPivotTable") 'Insert Blank Pivot Table Set PTable = PCache.CreatePivotTable(TableDestination:=PSheet.Cells(5, 1), TableName:="PRIMEPivotTable") 'Insert Row Fields With PTable.PivotFields("LT verification responsible") .Orientation = xlRowField .Position = 1 End With 'Insert Column Fields With PTable.PivotFields("LT Verification - Planned Week Numbers") .Orientation = xlColumnField .Position = 1 End With 'Pagefield With PTable.PivotFields("Build") .Orientation = xlPageField .Position = 1 End With With PTable.PivotFields("Current status") .Orientation = xlPageField .Position = 1 End With With PTable.PivotFields("Type of issue") .Orientation = xlPageField .Position = 1 End With 'Insert Data Field With PTable.PivotFields("ID") .Orientation = xlDataField .Position = 1 .Function = xlCount .Name = "Names" End With 'Format Pivot Table PTable.ShowTableStyleRowStripes = True PTable.TableStyle2 = "PivotStyleMedium9" Application.ScreenUpdating = True End Sub

why if you already created and Set PTable you are not using it ? why use such a long line like With ActiveSheet.PivotTables("PRIMEPivotTable").PivotFields("LT verification responsible") instead of With PTable.PivotFields("LT verification responsible") ?
@Shai Rado +1 for pointing that out. Yeah that's the way to refer to the pivot table if properly defined. I was lazy to change the whole code. I have edited it as per your suggestion. Thanks. :)
@sktneer This code is running without an error but only creates a tab named PivotTable but no pivot table is generated.
Where is the data located on W1715.2 Sheet? The code is using Set PRange = DSheet.Range("A1").CurrentRegion, which assumes that the headers are in row1 starting from A1.

Collectives™ on Stack Overflow

VBA code to generate Pivot Table in Excel 2010

1 Answer 1

8 Comments

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

8 Comments

Related