Jan 31 2019 07:17 AM
Hello,
I tried to use the VBA macro identified here:
However when i add it to my personal workbook module and run it on a pivot table it gives me the error compile error sub or function not defined.
I hope someone who is much more of an expert in VBA can help, this can save me endless hours.
Full Code attached.
Jan 31 2019 08:41 AM
Hi Frank,
This is because of some invalid characters in the code.
The code contains italic apostrophes and italic double quotes.
Please fix the code as follows:
Sub AdoptSourceFormatting()
'Mike Alexander
'www.datapigtechnologies’
'Be sure you start with your cursor inside a pivot table.
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 MyErr
'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
MyErr:
If Err.Number = 1004 Then
MsgBox "You must place your cursor inside of a pivot table."
Else
MsgBox Err.Number & vbCrLf & Err.Description
End If
End Sub
Jan 31 2019 12:16 PM
Jul 11 2022 05:39 AM
ActiveWindow.SmallScroll Down:=-39
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Range("A3:AC2135").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Sheets.Add
ActiveWorkbook.Worksheets("Sheet2").PivotTables("PivotTable2").PivotCaches
CreatePivotTable TableDestination:="Sheet3!R3C1", TableName:="PivotTable2", DefaultVersion:=7
Sheets("Sheet3").Select
There is a compile error sub or function not defined which then highlights CreatePivotTable.
Need Help