Add new value field in a pivot table using excel vba.

mohan.pandey87's picture
Some time we need to add a formula or value field in an existing pivot table. This procedure will do the same
Option Explicit
 
Enum CalcFieldType
    XLCOLSUM = 0
    XLCOLCOUNT = 1
End Enum
 
Sub AddCalculatedColumn(ByVal strPvtShtName As String, _
                        ByVal FuncType As CalcFieldType, _
                        ParamArray arrPvtList() As Variant)
 
    Dim wksSht              As Worksheet
    Dim objPvt              As PivotTable
    Dim objPvtFld           As PivotField
    Dim strPvtFldName       As String
    Dim strCustFldName      As String
    Dim lngLoop             As Long
    Dim lngLoop1            As Long
    Dim bolExist            As Boolean
    Dim lngSu               As Long
 
    With Application
        lngSu = .ScreenUpdating
        If .ScreenUpdating Then .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
 
    strPvtFldName = "Field Name"
    strCustFldName = "Custom Field Name"
 
    Set wksSht = ThisWorkbook.Worksheets(strPvtShtName)
 
    For lngLoop = LBound(arrPvtList) To UBound(arrPvtList, 1)
        With wksSht
            Set objPvt = .PivotTables(arrPvtList(lngLoop))
            objPvt.RefreshTable
            For lngLoop1 = 1 To objPvt.PivotFields.Count
                'Debug.Print objPvt.PivotFields(lngLoop1)
                If LCase(strPvtFldName) = LCase(objPvt.PivotFields(lngLoop1)) Then
                    bolExist = True
                    Exit For
                Else
                    bolExist = False
                End If
            Next lngLoop1
            If bolExist Then
                On Error Resume Next
                Set objPvtFld = objPvt.PivotFields(strCustFldName)
                On Error GoTo 0: On Error GoTo -1: Err.Clear
                If Not objPvtFld Is Nothing Then
                    objPvtFld.Orientation = xlHidden
                End If
                With objPvt
                    .AddDataField .PivotFields(strPvtFldName), strCustFldName
                End With
                With objPvt.PivotFields("Somme de " & strPvtFldName)
                    Select Case FuncType
                        Case 0:
                            .Caption = strCustFldName
                            .Function = xlSum
                        Case 1:
                            .Caption = "Custom Caption"
                            .Function = xlCount
                        Case Else
                            .Caption = "Custom Caption"
                            .Function = xlSum
                    End Select
                End With
            End If
        End With
    Next lngLoop
 
    With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = lngSu
    End With
 
End Sub
 
 
Here is how to use it.
 
Sub MCall_Proc()
 
    Call AddCalculatedColumn("SheetName", _
                            XLCOLSUM, _
                            "pvt1", "pvt2", "pvt3", "pvt4", _
                            "pvt5", "pvt6", "pvt7", "pvt8", "pvt9")
 
End Sub