- Joined
- Sep 25, 2009
- Messages
- 1
- Reaction score
- 0
I am trying to build a macro to be placed in a blank spreadsheet for use as a template. My development platform is Excel 2003 on Windows XP SP2. The script was initially recorded as a macro against a single data file with absolute range references and worked both on my develpment platform and on the production platform (Excel 2000 on Windows 2000). However, I have been having fits trying to convert it to dynamic addressing for the PivotCaches.Add. I develop Excel solutions a few times a year and this pivot table is the deepest I have dug into OLE code, so I am not an expert and could have a simple problem. I included the entire macro because I am unsure if there are sideeffects to what some of it is doing. I am getting a 1004 error "The PivotTable field is not valid. To create a PivotTable report, you must use data that is organized as a list with labeled columns. If you are changing the name of a PivotTable field, you must type a new name for the field."
Since I do not get this error with the absolute references, I am puzzled as to what to fix. That is another reason for supplying the entire macro:
Sub PivotMacro()
'
' PivotMacro Macro
' Macro recorded 7/14/2009 by Jim Snyder
'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\temp-16000000\TestFile.txt", _
Destination:=Range("A1"))
.FillAdjacentFormulas = True
.TextFileParseType = xlDelimited
.TextFileOtherDelimiter = "~"
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 2)
.Refresh BackgroundQuery:=False
End With
' Variables for determining current range
Dim DataRows As Long
Dim DataColumns As Long
' Dim PivotTableRange As Range
Dim PivotTableRange As String
Range("A1").Select
Selection.End(xlDown).Select
DataRows = ActiveCell.Row
Range("A1").Select
Selection.End(xlToRight).Select
DataColumns = ActiveCell.Column
' PivotTableRange = "Sheet1!R1C1:R" & Format(DataRows) & "C" & Format(DataColumns)
' PivotTableRange = ("Sheet1").Range("A1").CurrentRegion.Address
PivotTableRange = ActiveSheet.Range("A1").CurrentRegion.Address
Selection.EntireRow.Insert
Range("A1:O1").Select
Selection.NumberFormat = "@"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A1").Select
ActiveCell.FormulaR1C1 = "Check #"
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("B1").Select
ActiveCell.FormulaR1C1 = "Check Date"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("C1").Select
ActiveCell.FormulaR1C1 = "EOB #"
With ActiveCell.Characters(Start:=1, Length:=5).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("D1").Select
ActiveCell.FormulaR1C1 = "From Date"
With ActiveCell.Characters(Start:=1, Length:=9).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("E1").Select
ActiveCell.FormulaR1C1 = "To Date"
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("F1").Select
ActiveCell.FormulaR1C1 = "Type"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("G1").Select
ActiveCell.FormulaR1C1 = "Participant"
With ActiveCell.Characters(Start:=1, Length:=11).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("H1").Select
ActiveCell.FormulaR1C1 = "BPA Status"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("I1").Select
ActiveCell.FormulaR1C1 = "Type Code"
With ActiveCell.Characters(Start:=1, Length:=9).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("J1").Select
ActiveCell.FormulaR1C1 = "Plan"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("K1").Select
ActiveCell.FormulaR1C1 = "Member"
With ActiveCell.Characters(Start:=1, Length:=6).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("L1").Select
ActiveCell.FormulaR1C1 = "Patient"
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("M1").Select
ActiveCell.FormulaR1C1 = "Payee"
With ActiveCell.Characters(Start:=1, Length:=5).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("N1").Select
ActiveCell.FormulaR1C1 = "Check Amount"
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("O1").Select
ActiveCell.FormulaR1C1 = "Br #"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Columns("G:G").Select
Selection.ColumnWidth = 12.14
Columns("H:H").ColumnWidth = 7.71
Columns("I:I").ColumnWidth = 7.43
Columns("N:N").ColumnWidth = 9.86
Range("O2").Select
Range([a1].CurrentRegion.Address).Sort Key1:=Range("O2"), Order1:=xlAscending, Key2:= _
Range("H2"), Order2:=xlAscending, Key3:=Range("J2"), Order3:=xlAscending _
, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
PivotTableRange).CreatePivotTable TableDestination:="", TableName:= _
"SumPivotTable"
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Br #")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("SumPivotTable").PivotFields("BPA Status")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Type Code")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Plan")
.Orientation = xlRowField
.Position = 4
End With
With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Check Amount")
.Orientation = xlDataField
End With
Range("C6").Select
Selection.Delete
Range("B6").Select
Selection.Delete
Sheets("Sheet1").Select
Range([a1].CurrentRegion.Address).Select
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("A:A").ColumnWidth = 10
Columns("B:B").ColumnWidth = 10
Columns("C:C").ColumnWidth = 11
Columns("D
").ColumnWidth = 11
Columns("E:E").ColumnWidth = 9
Columns("F:F").ColumnWidth = 8
Columns("G:G").ColumnWidth = 12
Columns("H:H").ColumnWidth = 8
Columns("I:I").ColumnWidth = 8
Columns("J:J").ColumnWidth = 8
Columns("K:K").ColumnWidth = 26
Columns("L:L").ColumnWidth = 26
Columns("M:M").ColumnWidth = 40
Columns("N:N").ColumnWidth = 10
Columns("N:N").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight
Range("M1").Select
Selection.Copy
Range("N1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Concatenated Columns"
With ActiveCell.Characters(Start:=1, Length:=20).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("N2").Select
Selection.Copy
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("N2:N24"), Type:=xlFillDefault
Range("N2:N24").Select
Selection.NumberFormat = "General"
Range("N2").Select
ActiveCell.FormulaR1C1 = "=RC[-6]&RC[-5]&RC[-4]&RC[2]"
Range("N2").Select
Selection.AutoFill Destination:=Range("N2:" & DataRows), Type:=xlFillDefault
Range("N2:" & DataRows).Select
Range("O2").Select
Selection.Subtotal GroupBy:=14, Function:=xlSum, TotalList:=Array(15), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ChDir "C:\temp-16000000"
ActiveWorkbook.SaveAs Filename:= _
"C:\temp-16000000\TestFile.xls", FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Since I do not get this error with the absolute references, I am puzzled as to what to fix. That is another reason for supplying the entire macro:
Sub PivotMacro()
'
' PivotMacro Macro
' Macro recorded 7/14/2009 by Jim Snyder
'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\temp-16000000\TestFile.txt", _
Destination:=Range("A1"))
.FillAdjacentFormulas = True
.TextFileParseType = xlDelimited
.TextFileOtherDelimiter = "~"
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 2)
.Refresh BackgroundQuery:=False
End With
' Variables for determining current range
Dim DataRows As Long
Dim DataColumns As Long
' Dim PivotTableRange As Range
Dim PivotTableRange As String
Range("A1").Select
Selection.End(xlDown).Select
DataRows = ActiveCell.Row
Range("A1").Select
Selection.End(xlToRight).Select
DataColumns = ActiveCell.Column
' PivotTableRange = "Sheet1!R1C1:R" & Format(DataRows) & "C" & Format(DataColumns)
' PivotTableRange = ("Sheet1").Range("A1").CurrentRegion.Address
PivotTableRange = ActiveSheet.Range("A1").CurrentRegion.Address
Selection.EntireRow.Insert
Range("A1:O1").Select
Selection.NumberFormat = "@"
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Range("A1").Select
ActiveCell.FormulaR1C1 = "Check #"
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("B1").Select
ActiveCell.FormulaR1C1 = "Check Date"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("C1").Select
ActiveCell.FormulaR1C1 = "EOB #"
With ActiveCell.Characters(Start:=1, Length:=5).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("D1").Select
ActiveCell.FormulaR1C1 = "From Date"
With ActiveCell.Characters(Start:=1, Length:=9).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("E1").Select
ActiveCell.FormulaR1C1 = "To Date"
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("F1").Select
ActiveCell.FormulaR1C1 = "Type"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("G1").Select
ActiveCell.FormulaR1C1 = "Participant"
With ActiveCell.Characters(Start:=1, Length:=11).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("H1").Select
ActiveCell.FormulaR1C1 = "BPA Status"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("I1").Select
ActiveCell.FormulaR1C1 = "Type Code"
With ActiveCell.Characters(Start:=1, Length:=9).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("J1").Select
ActiveCell.FormulaR1C1 = "Plan"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("K1").Select
ActiveCell.FormulaR1C1 = "Member"
With ActiveCell.Characters(Start:=1, Length:=6).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("L1").Select
ActiveCell.FormulaR1C1 = "Patient"
With ActiveCell.Characters(Start:=1, Length:=7).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("M1").Select
ActiveCell.FormulaR1C1 = "Payee"
With ActiveCell.Characters(Start:=1, Length:=5).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("N1").Select
ActiveCell.FormulaR1C1 = "Check Amount"
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("O1").Select
ActiveCell.FormulaR1C1 = "Br #"
With ActiveCell.Characters(Start:=1, Length:=4).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Columns("G:G").Select
Selection.ColumnWidth = 12.14
Columns("H:H").ColumnWidth = 7.71
Columns("I:I").ColumnWidth = 7.43
Columns("N:N").ColumnWidth = 9.86
Range("O2").Select
Range([a1].CurrentRegion.Address).Sort Key1:=Range("O2"), Order1:=xlAscending, Key2:= _
Range("H2"), Order2:=xlAscending, Key3:=Range("J2"), Order3:=xlAscending _
, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
PivotTableRange).CreatePivotTable TableDestination:="", TableName:= _
"SumPivotTable"
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Br #")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("SumPivotTable").PivotFields("BPA Status")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Type Code")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Plan")
.Orientation = xlRowField
.Position = 4
End With
With ActiveSheet.PivotTables("SumPivotTable").PivotFields("Check Amount")
.Orientation = xlDataField
End With
Range("C6").Select
Selection.Delete
Range("B6").Select
Selection.Delete
Sheets("Sheet1").Select
Range([a1].CurrentRegion.Address).Select
Selection.Copy
Sheets("Sheet2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Columns("A:A").ColumnWidth = 10
Columns("B:B").ColumnWidth = 10
Columns("C:C").ColumnWidth = 11
Columns("D
").ColumnWidth = 11Columns("E:E").ColumnWidth = 9
Columns("F:F").ColumnWidth = 8
Columns("G:G").ColumnWidth = 12
Columns("H:H").ColumnWidth = 8
Columns("I:I").ColumnWidth = 8
Columns("J:J").ColumnWidth = 8
Columns("K:K").ColumnWidth = 26
Columns("L:L").ColumnWidth = 26
Columns("M:M").ColumnWidth = 40
Columns("N:N").ColumnWidth = 10
Columns("N:N").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight
Range("M1").Select
Selection.Copy
Range("N1").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Concatenated Columns"
With ActiveCell.Characters(Start:=1, Length:=20).Font
.Name = "Century Gothic"
.FontStyle = "Bold"
.Size = 11
End With
Range("N2").Select
Selection.Copy
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("N2:N24"), Type:=xlFillDefault
Range("N2:N24").Select
Selection.NumberFormat = "General"
Range("N2").Select
ActiveCell.FormulaR1C1 = "=RC[-6]&RC[-5]&RC[-4]&RC[2]"
Range("N2").Select
Selection.AutoFill Destination:=Range("N2:" & DataRows), Type:=xlFillDefault
Range("N2:" & DataRows).Select
Range("O2").Select
Selection.Subtotal GroupBy:=14, Function:=xlSum, TotalList:=Array(15), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
ChDir "C:\temp-16000000"
ActiveWorkbook.SaveAs Filename:= _
"C:\temp-16000000\TestFile.xls", FileFormat:=xlNormal _
, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False