Capture.JPG
A good first step would be to make the macros easier to follow by cleaning up the extraneous lines the macro recorder includes
ActiveWindow.ScrollColumn = 2 ' delete
Columns("BQ:BQ").Select ' instead of this
Selection.Delete Shift:=xlToLeft
Columns("BQ:BQ").Delete Shift:=xlToLeft ' you do not need to Select most things
'instead of
Range("AW2:BA2").Select
Range("AW2:BA2").Select
Selection.Copy
Range("AW2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'something like this
Range("AW2:BA2").Copy
Range("AW2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks :=False, Transpose:=False
'instead of
Range("B2").Select
ActiveCell.FormulaR1C1 = "Date Ran"
Range("B2").Value = "Date Ran"
There's some other things that could be cleaned up or made more efficient
Sub CreatePivot()
' Create Pivot Table Macro
' Create Pivot Table
On Error Resume Next ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Application.DisplayAlerts = False
Worksheets("Pivot").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Worksheets.Add
pivotWS = "Pivot"
ActiveSheet.Name = pivotWS
'SourceData hard coded to test
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:="SF_ShopLoad_WCDet!a2:m45", Version:=7).CreatePivotTable _
TableDestination:=pivotWS & "!R3C1", DefaultVersion:=7
With Worksheets(pivotWS).PivotTables(1)
.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = False
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow
.PivotCache.RefreshOnFileOpen = False
.PivotCache.MissingItemsLimit = xlMissingItemsDefault
.RepeatAllLabels xlRepeatLabels
With .PivotFields("Work Center Summary")
.Orientation = xlRowField
.Position = 1
End With
Dim rHeaders As Range
Dim sAddr As String
Dim i As Long
sAddr = Application.ConvertFormula(.SourceData, x1R2C3, xlA1)
Set rHeaders = Range(sAddr)
' MsgBox rHeaders.Cells(2, 4).Value ' ROW 2 on worksheet, but row ONE in rHeaders <<<<<<<<<<<<<<<<<<<<<<<<<<<
MsgBox rHeaders.Cells(1, 3).Value
For i = 3 To rHeaders.Columns.Count
If IsDate(rHeaders.Cells(1, i).Value) Then
.AddDataField .PivotFields(rHeaders.Cells(1, i).Text), "Sum of " & rHeaders.Cells(1, i).Value, xlSum
Else
.AddDataField .PivotFields(rHeaders.Cells(1, i).Value), "Sum of " & rHeaders.Cells(1, i).Value, xlSum
End If
Next i
End With
Sheets(pivotWS).Select
Sheets(pivotWS).Name = "Pivot"
End Sub
Deleted chart stuff to test