pivot table build using excel macro

J

jnewl

used the excel macro routine to build this macro. did not make any changes to
the code, however, get error 1004 - addfields method of pivot table class
failed'.

when i build the pivot table manually using the same data, i get a pivot
table and no error. so why would microsoft work one way and not the other?

anyway, can you tell me what is wrong with this code?

it is failing at this location
"freqersu6mon!C1:C19").CreatePivotTable TableDestination:="", TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10


Sub freqersu6mon()
'
' freqersu6mon Macro
' Macro recorded 1/10/2006 by Template
Dim currmonth, curryear, prevyear, prevmonth, datelitl, datex,
prevyear2, lrow
checkslash = Mid(Date, 2, 1)
If checkslash = "/" Then
currmonth = Left(Date, 1)
curryear = Mid(Date, 8, 2)
Else
currmonth = Left(Date, 2)
curryear = Mid(Date, 9, 2)
End If
prevyear2 = curryear - 1
prevyear = "0" & prevyear2

If currmonth = "6" Then
datelitl = "December, 20" & prevyear & " thru May, 20" & curryear
End If
If currmonth = "7" Then
datelitl = "January, 20" & curryear & " thru June, 20" & curryear
End If
If currmonth = "8" Then
datelitl = "February, 20" & curryear & " thru July, 20" & curryear
End If
If currmonth = "9" Then
datelitl = "March, 20" & curryear & " thru August, 20" & curryear
End If
If currmonth = "10" Then
datelitl = "April, 20" & curryear & " thru September, 20" & curryear
End If
If currmonth = "11" Then
datelitl = "May, 20" & curryear & " thru October, 20" & curryear
End If
If currmonth = "12" Then
datelitl = "June, 20" & curryear & " thru November, 20" & curryear
End If
If currmonth = "1" Then
datelitl = "July, 20" & prevyear & " thru December, 20" & prevyear
End If
If currmonth = "2" Then
datelitl = "August, 20" & prevyear & " thru January, 20" & curryear
End If
If currmonth = "3" Then
datelitl = "September, 20" & prevyear & " thru February, 20" & curryear
End If
If currmonth = "4" Then
datelitl = "October, 20" & prevyear & " thru March, 20" & curryear
End If
If currmonth = "5" Then
datelitl = "November, 20" & prevyear & " thru April, 20" & curryear
End If

Rows("1:2").Select
Selection.Delete Shift:=xlUp
Cells.Select
With Selection.Font
.Name = "Garamond"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("C2").Select
Columns("C:C").ColumnWidth = 17
Columns("F:F").ColumnWidth = 44
ActiveWindow.SmallScroll ToRight:=5
Columns("G:G").ColumnWidth = 30.29
Columns("G:G").ColumnWidth = 47.14
ActiveWindow.ScrollColumn = 7
Columns("H:H").ColumnWidth = 39.57
Columns("I:I").ColumnWidth = 33.57
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
Columns("J:J").ColumnWidth = 31.29
Columns("J:J").Select
Columns("K:K").ColumnWidth = 33.71
Range("K18").Select
ActiveWindow.ScrollColumn = 10
Columns("L:L").ColumnWidth = 34.71
Columns("L:L").ColumnWidth = 42.29
ActiveWindow.ScrollColumn = 11
Columns("M:M").ColumnWidth = 42
ActiveWindow.ScrollColumn = 12
Columns("P:p").ColumnWidth = 25.57
ActiveWindow.ScrollColumn = 13
Columns("Q:Q").ColumnWidth = 27.29

Columns("F:F").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Columns("F:J").Select
Selection.NumberFormat = "0"
Range("F2").Select
ActiveCell.FormulaR1C1 = "=YEAR(RC[-1])"
Range("G2").Select
ActiveCell.FormulaR1C1 = "=MONTH(RC[-2])"
Range("H2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]<10,0,"""")"
Range("I2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-3],RC[-1],RC[-2])"
Range("F2:I2").Select
Selection.Copy
lrow = Range("A" & Rows.Count).End(xlUp).Row
Range("F2:I" & lrow).Select
ActiveSheet.Paste
Columns("I:I").Select
Application.CutCopyMode = False
Selection.Copy
Columns("J:J").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Columns("F:I").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("F1").Select
ActiveCell.FormulaR1C1 = "year month"
Cells.Select
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
"freqersu6mon!C1:C19").CreatePivotTable TableDestination:="",
TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable1").AddFields RowFields:="Emp Grp", _
ColumnFields:="year month"
With ActiveSheet.PivotTables("PivotTable1").PivotFields("year month")
.Orientation = xlDataField
.Caption = "Total visits"
End With
Application.CommandBars("PivotTable").Visible = False
ActiveWorkbook.ShowPivotTableFieldList = False
Rows("3:3").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "employer group"
Range("A6").Select
ActiveSheet.PivotTables("PivotTable1").PivotFields("Emp Grp").Caption = _
"Employer group"
Range("A1").Select
ActiveCell.FormulaR1C1 = "Univera ER managed care data"
Range("A2").Select
ActiveCell.FormulaR1C1 = "Medicare & Blue Choice"
Range("A3").Select
ActiveCell.FormulaR1C1 = datelitl
Sheets("freqersu6mon").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWorkbook.Worksheets("employer group").PivotTables("PivotTable1"). _
PivotCache.CreatePivotTable TableDestination:="",
TableName:="PivotTable2" _
, DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTables("PivotTable2").AddFields RowFields:="Product", _
ColumnFields:="year month"
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Product")
.Orientation = xlDataField
.Caption = "Total visits"
End With
ActiveWorkbook.ShowPivotTableFieldList = True
ActiveWorkbook.ShowPivotTableFieldList = False
Application.CommandBars("PivotTable").Visible = False
Sheets("Sheet2").Select
Sheets("Sheet2").Name = "Product"
Range("A27").Select
Selection.Delete
Rows("2:2").Select
Selection.Insert Shift:=xlDown
Selection.Insert Shift:=xlDown
Range("A1").Select
ActiveCell.FormulaR1C1 = "Univera ER managed care data"
Range("A2").Select
ActiveCell.FormulaR1C1 = "Medicare & Blue Choice"
Range("A3").Select
ActiveCell.FormulaR1C1 = datelitl
Range("A8").Select
chdir "E:\adhoc_team\jnewland\erfreqflyer"
ActiveWorkbook.SaveAs Filename:= _
"E:\adhoc_team\jnewland\erfreqflyer\freqersu6mon.xls", FileFormat:= _
xlExcel9795, Password:="", WriteResPassword:="",
ReadOnlyRecommended:= _
False, CreateBackup:=False
ActiveWorkbook.Close
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top