I have a report that I am creating using a pivot table. Everything works great except formatting. The pivot table can be expanded and contracted to drill down into different layers and when this happens, formatting issues arise. To combat this, I use a button to run the macro at the bottom to derive the formatting from the source data. Unfortunately, there are calculated fields that do not have source data, and thus the formatting is still an issue.
Two questions:
How can I best fix the calculated field formatting issue?
Is there an event I can tie the macro to that will run if fields are expanded or contracted?
Thanks,
Kurt
Sub SourceFormat()
Dim oPivotTable As PivotTable
Dim oPivotFields As PivotField
Dim oSourceRange As Range
Dim strLabel As String
Dim strFormat As String
Dim i As Integer
On Error GoTo Err1
'Identify PivotTable and capture source Range
Set oPivotTable = ActiveSheet.PivotTables(ActiveCell.PivotTable.Name)
Set oSourceRange = Range(Application.ConvertFormula(oPivotTable.SourceData, xlR1C1, xlA1))
'Refresh PivotTable to synch with latest data
oPivotTable.PivotCache.Refresh
'Start looping through the columns in source range
For i = 1 To oSourceRange.Columns.Count
'Trap the column name and number format for first row of the column
strLabel = oSourceRange.Cells(1, i).Value
strFormat = oSourceRange.Cells(2, i).NumberFormat
'Now loop through the fields PivotTable data area
For Each oPivotFields In oPivotTable.DataFields
'Check for match on SourceName then appply number format if there is a match
If oPivotFields.SourceName = strLabel Then
oPivotFields.NumberFormat = strFormat
'Bonus: Change the name of field to Source Column Name
oPivotFields.Caption = strLabel & " "
End If
Next oPivotFields
Next i
Exit Sub
'Error stuff
Err1:
If Err.Number = 1004 Then
MsgBox "Cursor must be inside of a pivot table."
Else
MsgBox Err.Number & vbCrLf & Err.Description
End If
End Sub
Bookmarks