Hi All,
I have pieced together a VBA script to create a pivot table. Which is all great and works fine BUT for some reason it is now forcing the table onto a new worksheet. Please see code below and advise if any ideas why it might be creating a new sheet. Also before anyone asks: yes the sheet Worksheets("TICKETS BY OWNER & DAY") does exist.
I have pieced together a VBA script to create a pivot table. Which is all great and works fine BUT for some reason it is now forcing the table onto a new worksheet. Please see code below and advise if any ideas why it might be creating a new sheet. Also before anyone asks: yes the sheet Worksheets("TICKETS BY OWNER & DAY") does exist.
Code:
' HERE WE CREATE THE PIVOT TABLES AND CHARTS FOR REPORTS
Dim WSD1 As Worksheet
Dim WSD2 As Worksheet
Dim WSD3 As Worksheet
Dim PTCache As PivotCache
Dim PT As PivotTable
Dim PRange As Range
Dim FinalRow As Long
Dim FinalCol As Long
Set WSD1 = Worksheets("RAW DATA")
Set WSD2 = Worksheets("TOP 10 USERS & SUBJECTS")
Set WSD3 = Worksheets("TICKETS BY OWNER & DAY")
Application.StatusBar = StatusMain & StatusLocal & "Setting Source Data"
' Define input area and set up a Pivot Cache
FinalRow = WSD1.Cells(Application.Rows.Count, 1).End(xlUp).Row
FinalCol = WSD1.Cells(1, Application.Columns.Count).End(xlToLeft).Column
Set PRange = WSD1.Cells(1, 1).Resize(FinalRow, FinalCol)
Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange)
'----------------------------------------------------------------------------------------
Application.StatusBar = StatusMain & StatusLocal & "TICKETS BY OWNER"
' Select the TICKETS BY OWNER & DAY sheet
WSD3.Select
' Delete prior pivot table
On Error Resume Next
ActiveSheet.PivotTables("PTTicketOwners").TableRange2.ClearContents
On Error GoTo 0
' CREATE THE TICKET OWNERS REPORT
Set PT = PTCache.CreatePivotTable(TableDestination:=Worksheets("TICKETS BY OWNER & DAY").Cells(1, 27), TableName:="PTTicketOwners")
PT.ManualUpdate = True
' Set up the row & column fields
PT.AddFields RowFields:="Owner"
' Set up the data fields
With PT.PivotFields("Owner")
.Orientation = xlDataField
.Function = xlCount
.Position = 1
End With
Set PT = ActiveSheet.PivotTables("PTTicketOwners")
PT.ManualUpdate = True
' This section Formats the PivotTable settings
With PT
.InGridDropZones = False
.RowAxisLayout xlTabularRow
.TableStyle2 = "PivotStyleLight16"
.DisplayContextTooltips = False
.ShowDrillIndicators = False
.HasAutoFormat = False
.DisplayNullString = False
End With
' This sets each field in Descending order.
For Each pf In PT.PivotFields
pf.AutoSort xlDescending, pf.Name
pf.Subtotals(1) = True
pf.Subtotals(1) = False
Next pf
' This command changes the formatting of any field that appears in the Values area
For Each pf In PT.DataFields
pf.Function = xlCount
Next pf
' Shorten the description of field(s) in the Values area
With PT.PivotFields("Count of Owner")
.Caption = "Count"
End With
With PT.PivotFields("Owner")
.Caption = "Ticket Owner"
End With
' Set to top 10 results
PT.PivotFields("Ticket Owner").AutoShow xlAutomatic, xlTop, 10, "Count"
PT.ManualUpdate = False
' Clear all un-used data from this table
PT.PivotCache.MissingItemsLimit = xlMissingItemsNone
' Move the pivot table into correct place
PT.Location = WSD3.Cells(6, 2)