Slicemahn
04-01-2015, 10:28 AM
Hi Everyone,
I need a second pair eyes because the code I have written to generate pivot tables on different sheets is ... not working. Here is the code below:
Private Sub DynamicPivot()
Dim pvtTbl As PivotTable
Dim wsData As Worksheet
Dim rngData As Range
Dim pvtTbleCache As PivotCache
Dim wsPvtTbl As Worksheet
Dim pvtFld As PivotField
Dim i As Integer
Dim j As Integer
For i = 1 To 3 'step for each sheet
For j = 4 To 6 'step for outbound sheets
' Determine the data area
Set wsData = Sheets("RPT_" & i)
' Set the output location
Set wsPvtTbl = Worksheets("Sheet" & j)
' Looking for existing Pivot Tables and deleting them upon a user's agreement to do so
For Each pvtTbl In wsPvtTbl.PivotTables
If MsgBox("Delete existing PivotTable !", vbYesNo) = vbYes Then
pvtTbl.TableRange2.Clear
End If
Next pvtTbl
' Determining the Range for the Pivot Table to capture
Sheets("RPT_" & i).Activate
Set rngData = wsData.Range("A1").CurrentRegion
' Setting the Pivot Table up
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=rngData, _
Version:=xlPivotTableVersion14).CreatePivotTable TableDestination:=wsPvtTbl.Range("B3"), _
Tablename:="Month_" & i, DefaultVersion:=xlPivotTableVersion14
' Naming the Pivot Table
Set pvtTbl = wsPvtTbl.PivotTables("Month_" & i)
' Prevention of the Pivot Table to update values while Pivotfields are being arranged
pvtTbl.ManualUpdate = False
' Setting up the fields for Pivtot table
Set pvtFld = pvtTbl.PivotFields("ROLE"): pvtFld.Orientation = xlRowField: pvtFld.Position = 1
Set pvtFld = pvtTbl.PivotFields("LEVEL_2"): pvtFld.Orientation = xlRowField: pvtFld.Position = 2
Set pvtFld = pvtTbl.PivotFields("LEVEL_3"): pvtFld.Orientation = xlRowField: pvtFld.Position = 3
Set pvtFld = pvtTbl.PivotFields("LEVEL_4"): pvtFld.Orientation = xlRowField: pvtFld.Position = 4
Set pvtFld = pvtTbl.PivotFields("LEVEL_5"): pvtFld.Orientation = xlRowField: pvtFld.Position = 5
Set pvtFld = pvtTbl.PivotFields("NAME"): pvtFld.Orientation = xlRowField: pvtFld.Position = 6
Set pvtFld = pvtTbl.PivotFields("RPT_ORD"): pvtFld.Orientation = xlColumnField: pvtFld.Position = 1
Set pvtFld = pvtTbl.PivotFields("Course_Title"): pvtFld.Orientation = xlColumnField: pvtFld.Position = 2
With pvtTbl.PivotFields("USERNAME")
.Orientation = xlDataField
.Function = xlCount
.Position = 1
End With
With pvtTbl.DataPivotField
.PivotItems ("COUNT OF USERNAME")
.Caption = "Role / Business Unit"
End With
' With pvtTbl.PivotFields("RPT_ORD").Subtotals = Array _
' (False, False, False, False, False, False, False, False, False, False, False, False)
' End With
With pvtTbl
.PivotFields("LEVEL_2").DrillTo "LEVEL_4"
.TableStyle2 = "PivotStyleLight16"
End With
' Allow the table to Update values
pvtTbl.ManualUpdate = True
wsPvtTbl.Activate
Rows(5).RowHeight = 75
Range("C6").Select
ActiveWindow.FreezePanes = True
Next j
Next i
End Sub
I have attached the spreadsheet with sample data and the outcome desired. Thanks in advance for your help.
I need a second pair eyes because the code I have written to generate pivot tables on different sheets is ... not working. Here is the code below:
Private Sub DynamicPivot()
Dim pvtTbl As PivotTable
Dim wsData As Worksheet
Dim rngData As Range
Dim pvtTbleCache As PivotCache
Dim wsPvtTbl As Worksheet
Dim pvtFld As PivotField
Dim i As Integer
Dim j As Integer
For i = 1 To 3 'step for each sheet
For j = 4 To 6 'step for outbound sheets
' Determine the data area
Set wsData = Sheets("RPT_" & i)
' Set the output location
Set wsPvtTbl = Worksheets("Sheet" & j)
' Looking for existing Pivot Tables and deleting them upon a user's agreement to do so
For Each pvtTbl In wsPvtTbl.PivotTables
If MsgBox("Delete existing PivotTable !", vbYesNo) = vbYes Then
pvtTbl.TableRange2.Clear
End If
Next pvtTbl
' Determining the Range for the Pivot Table to capture
Sheets("RPT_" & i).Activate
Set rngData = wsData.Range("A1").CurrentRegion
' Setting the Pivot Table up
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=rngData, _
Version:=xlPivotTableVersion14).CreatePivotTable TableDestination:=wsPvtTbl.Range("B3"), _
Tablename:="Month_" & i, DefaultVersion:=xlPivotTableVersion14
' Naming the Pivot Table
Set pvtTbl = wsPvtTbl.PivotTables("Month_" & i)
' Prevention of the Pivot Table to update values while Pivotfields are being arranged
pvtTbl.ManualUpdate = False
' Setting up the fields for Pivtot table
Set pvtFld = pvtTbl.PivotFields("ROLE"): pvtFld.Orientation = xlRowField: pvtFld.Position = 1
Set pvtFld = pvtTbl.PivotFields("LEVEL_2"): pvtFld.Orientation = xlRowField: pvtFld.Position = 2
Set pvtFld = pvtTbl.PivotFields("LEVEL_3"): pvtFld.Orientation = xlRowField: pvtFld.Position = 3
Set pvtFld = pvtTbl.PivotFields("LEVEL_4"): pvtFld.Orientation = xlRowField: pvtFld.Position = 4
Set pvtFld = pvtTbl.PivotFields("LEVEL_5"): pvtFld.Orientation = xlRowField: pvtFld.Position = 5
Set pvtFld = pvtTbl.PivotFields("NAME"): pvtFld.Orientation = xlRowField: pvtFld.Position = 6
Set pvtFld = pvtTbl.PivotFields("RPT_ORD"): pvtFld.Orientation = xlColumnField: pvtFld.Position = 1
Set pvtFld = pvtTbl.PivotFields("Course_Title"): pvtFld.Orientation = xlColumnField: pvtFld.Position = 2
With pvtTbl.PivotFields("USERNAME")
.Orientation = xlDataField
.Function = xlCount
.Position = 1
End With
With pvtTbl.DataPivotField
.PivotItems ("COUNT OF USERNAME")
.Caption = "Role / Business Unit"
End With
' With pvtTbl.PivotFields("RPT_ORD").Subtotals = Array _
' (False, False, False, False, False, False, False, False, False, False, False, False)
' End With
With pvtTbl
.PivotFields("LEVEL_2").DrillTo "LEVEL_4"
.TableStyle2 = "PivotStyleLight16"
End With
' Allow the table to Update values
pvtTbl.ManualUpdate = True
wsPvtTbl.Activate
Rows(5).RowHeight = 75
Range("C6").Select
ActiveWindow.FreezePanes = True
Next j
Next i
End Sub
I have attached the spreadsheet with sample data and the outcome desired. Thanks in advance for your help.