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 Subodh Tiwari sktneer · Accepted Answer · 2017-04-11T20:39:30

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

VBA code to generate Pivot Table in Excel 2010

1 Answers