Add new value field in a pivot table using excel vba.
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
»
- mohan.pandey87's blog
- Login or register to post comments
- 13372 reads
Recent comments
5 years 42 weeks ago
6 years 28 weeks ago
6 years 40 weeks ago
6 years 42 weeks ago
6 years 43 weeks ago
6 years 49 weeks ago
7 years 5 weeks ago
7 years 5 weeks ago
7 years 5 weeks ago
7 years 5 weeks ago