VBA dynamic column names in pivot tables

[MPaulus]

I have a macro written to create a pivot table, however the column names are set for the original recording. I need to change the code so the names are dynamic based off specific cell contents. The locations of these cells do not change.

I have posted this in another thread, but have not had a response https://www.mrexcel.com/board/threads/pivot-table-column-names-in-vba.1184570/

I am trying to change the names of my pivot table columns that is created in a macro. The names of the columns from my data table will always change, but the locations will remain the same.


ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
"PivotTable5").PivotFields("Total Late Hrs"), "Sum of Total Late Hrs", xlSum
ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
"PivotTable5").PivotFields("12-Oct-21"), "Sum of 12-Oct-21", xlSum
ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
"PivotTable5").PivotFields("19-Oct-21"), "Sum of 19-Oct-21", xlSum
ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
"PivotTable5").PivotFields("26-Oct-21"), "Sum of 26-Oct-21", xlSum
ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
"PivotTable5").PivotFields("2-Nov-21"), "Sum of 2-Nov-21", xlSum
ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
"PivotTable5").PivotFields("9-Nov-21"), "Sum of 9-Nov-21", xlSum
ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
"PivotTable5").PivotFields("40 Hr Capacity"), "Sum of 40 Hr Capacity", xlSum
ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
"PivotTable5").PivotFields("50 Hr Capacity"), "Sum of 50 Hr Capacity", xlSum
ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
"PivotTable5").PivotFields("60 Hr Capacity"), "Sum of 60 Hr Capacity", xlSum

The dates in the above columns will come from cells E2, F2, G2, H2 and I2 of my data sheet. What is the proper format to name these columns from those cells?

I have tried using:
ActiveSheet.PivotTables("PivotTable5").AddDataField ActiveSheet.PivotTables( _
"PivotTable5").PivotFields(E2), "Sum of "E2, xlSum

But I get an error message Expected: end of statement with E2 highlighted after "Sum of ".

[Paul_Hossler]

rHeaders contains the data source fields, so (1,1) contains the first field, etc.




Option Explicit




Sub test()
Dim rHeaders As Range
Dim sAddr As String

With ActiveSheet.PivotTables(1)

sAddr = Application.ConvertFormula(.SourceData, xlR1C1, xlA1)

Set rHeaders = Range(sAddr)

MsgBox rHeaders.Cells(1, 1).Value
MsgBox rHeaders.Cells(1, 2).Value
MsgBox rHeaders.Cells(1, 3).Value
MsgBox rHeaders.Cells(1, 4).Value

.AddDataField .PivotFields(rHeaders.Cells(1, 1).Value), "Sum of " & rHeaders.Cells(1, 1).Value, xlSum

End With


End Sub

[MPaulus]

When I changed what I thought needed to be replaced with what you have above, I couldn't even get the macro to run that far. It would stop at creating the cache. The ShopLoad_Step4 macro in the attached file was my first attempt and where I was having troubles with the date names in fields as opposed the source fields. The CreatePivot is where I tried inserting your code. This is where it was getting hung up:


ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ "SF_ShopLoad_WCDet!a2:m" & lr, Version:=7).CreatePivotTable _
TableDestination:=pivotWS & "!R3C1", TableName:="PivotTable5", DefaultVersion _
:=7

[Paul_Hossler]

29067

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

[MPaulus]

Paul,

Thank you for all of your help on this!

Mike