Macro to create/edit calculated fields from a range

[nc]

Hi

I have set up the AddItems name with range =Sheet1!$D$3:$E$13

The pivot table and the above range are on "Sheet 1"

Recorded the following macro,

Sub Macro3()
'
' Macro3 Macro
' Macro recorded 12/05/2006 by Authorised User

ActiveSheet.PivotTables("PivotTable1").CalculatedFields.Add "A1P3
Error", "= 0" _
, True
ActiveSheet.PivotTables("PivotTable1").PivotFields("A1P3
Error").Orientation = _
xlDataField
ActiveSheet.PivotTables("PivotTable1").CalculatedFields("A1P3 Error"). _
StandardFormula = "= 2"

End Sub


Then made changes to Debra Dalgleish suggested macro

Sub CreateCalcFields()

Dim rngItems As Range
Dim ws As Worksheet
Dim pt As PivotTable
Dim c As Range
Dim pf As PivotField

Set ws = Worksheets("Sheet1")
Set pt = ws.PivotTables("PivotTable1")
Set rngItems = ws.Range("AddItems")

For Each c In rngItems
On Error Resume Next
Set pf = ws.PivotTables("PivotTable1").CalculatedFields(c.Value)
On Error GoTo 0
If Not pf Is Nothing Then
ws.PivotTables("PivotTable1").CalculatedFields(c.Value) _
.StandardFormula = c.Offset(0, 1).Value
Else
ws.PivotTables("PivotTable1").CalculatedFields.Add _
c.Value, c.Offset(0, 1).Value, True
pt.PivotFields(c.Value).Orientation = xlDataField
End If
Next c

End Sub


When I try to run the macro I am getting the following error message box
"Run-time error '7' Out of Memory".


Please help.