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
- 13312 reads
Recent comments
5 years 27 weeks ago
6 years 13 weeks ago
6 years 25 weeks ago
6 years 28 weeks ago
6 years 29 weeks ago
6 years 34 weeks ago
6 years 43 weeks ago
6 years 43 weeks ago
6 years 43 weeks ago
6 years 43 weeks ago