Slicemahn
11-29-2007, 03:19 AM
Hello Everyone!
I need a second pair of eyes. I am trying to cycle through the items in my page field of the pivot table in order to create 7 seperate worksheets. When I execute the code only the first of the seven reveals data whereas the rest are blank. Could someone show me where I am wrong:
Public Sub TollFreeCreatePivotTable()
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim LastRow As Long
Dim LastCol As Long
Dim rngSource As Range
Dim Wks As Worksheet
Dim Wkr As Worksheet
Dim c As Integer
Application.ScreenUpdating = False
'Delete PivotSheet if it exists
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Pivotdata").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'Create a Pivot Cache
Set PTCache = ActiveWorkbook.PivotCaches.Add( _
SourceType:=xlDatabase, _
SourceData:=Sheets("tblCallFulfillment").Range("A1").CurrentRegion.Address)
'Add new worksheet
Set Wks = Worksheets.Add
Wks.Name = "Pivotdata"
'Create the pivot table from the cache
Set PT = PTCache.CreatePivotTable( _
TableDestination:=Wks.Range("A1"), _
TableName:="RorysPivot")
With PT
'Add fields
.AddFields RowFields:=Array("ProgramName", "Dialed Number", "ProgramLaunchDate", "ProgramEndDate", "Area_Code"), ColumnFields:="Date", PageFields:="LOB"
.PivotFields("Calls_Offered").Orientation = xlDataField
.TableRange1.EntireColumn.AutoFit
End With
PT.PivotSelect "'Dialed Number'[All;Total]", xlDataAndLabel, True
Selection.Delete
PT.PivotSelect "ProgramLaunchDate[All;Total]", xlDataAndLabel, True
Selection.Delete
PT.PivotSelect "ProgramEndDate[All;Total]", xlDataAndLabel, True
Selection.Delete
For c = 1 To PT.PivotFields("LOB").PivotItems.Count
PT.PivotFields("LOB").CurrentPage = PT.PivotFields("LOB").PivotItems(c).Name
PT.ManualUpdate = False
PT.ManualUpdate = True
ActiveWorkbook.Worksheets.Add
Sheets(c).Name = PT.PivotFields("LOB").PivotItems(c).Name
PT.TableRange2.Offset(1, 0).Copy
Sheets(c).Range("A3").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Range("A3").Select
Next c
End Sub
I need a second pair of eyes. I am trying to cycle through the items in my page field of the pivot table in order to create 7 seperate worksheets. When I execute the code only the first of the seven reveals data whereas the rest are blank. Could someone show me where I am wrong:
Public Sub TollFreeCreatePivotTable()
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim LastRow As Long
Dim LastCol As Long
Dim rngSource As Range
Dim Wks As Worksheet
Dim Wkr As Worksheet
Dim c As Integer
Application.ScreenUpdating = False
'Delete PivotSheet if it exists
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Pivotdata").Delete
On Error GoTo 0
Application.DisplayAlerts = True
'Create a Pivot Cache
Set PTCache = ActiveWorkbook.PivotCaches.Add( _
SourceType:=xlDatabase, _
SourceData:=Sheets("tblCallFulfillment").Range("A1").CurrentRegion.Address)
'Add new worksheet
Set Wks = Worksheets.Add
Wks.Name = "Pivotdata"
'Create the pivot table from the cache
Set PT = PTCache.CreatePivotTable( _
TableDestination:=Wks.Range("A1"), _
TableName:="RorysPivot")
With PT
'Add fields
.AddFields RowFields:=Array("ProgramName", "Dialed Number", "ProgramLaunchDate", "ProgramEndDate", "Area_Code"), ColumnFields:="Date", PageFields:="LOB"
.PivotFields("Calls_Offered").Orientation = xlDataField
.TableRange1.EntireColumn.AutoFit
End With
PT.PivotSelect "'Dialed Number'[All;Total]", xlDataAndLabel, True
Selection.Delete
PT.PivotSelect "ProgramLaunchDate[All;Total]", xlDataAndLabel, True
Selection.Delete
PT.PivotSelect "ProgramEndDate[All;Total]", xlDataAndLabel, True
Selection.Delete
For c = 1 To PT.PivotFields("LOB").PivotItems.Count
PT.PivotFields("LOB").CurrentPage = PT.PivotFields("LOB").PivotItems(c).Name
PT.ManualUpdate = False
PT.ManualUpdate = True
ActiveWorkbook.Worksheets.Add
Sheets(c).Name = PT.PivotFields("LOB").PivotItems(c).Name
PT.TableRange2.Offset(1, 0).Copy
Sheets(c).Range("A3").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Range("A3").Select
Next c
End Sub