I would like to scale (divide, multiply) a pivot tables value by some constant that I add into the pivot tables sheet, like so:
The problem of automatically updating the pivot tables values as the values in the original data change I already solved with this code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range) ActiveWorkbook.Worksheets("Sheet4").PivotTables(1).PivotCache.Refresh End Sub
I have tried simply doing it inside a worksheet_change() method, but this gives type mismatch error:
Private Sub Worksheet_Change(ByVal Target As Range) If Not Application.Intersect(Range("C4:C5"), Range(Target.Address)) Is Nothing Then Application.EnableEvents = False 'Target.Value = Target.Value * Range("B1").Value <-- gives error of type mismatch MsgBox VarType(Target.Value) MsgBox VarType(Range("B1").Value) Application.EnableEvents = True End If End Sub
Here is one way. When the event
WorkSheet_Change fires, check if your scaling value (in
B1) has changed. If so, re-write the calculated field:
Private Sub Worksheet_Change(ByVal Target As Range) If Not Application.Intersect(Range("B1"), Range(Target.Address)) Is Nothing Then ActiveWorkbook.Worksheets("Sheet4").PivotTables(1).CalculatedFields("ScaledField"). _ StandardFormula = "=Kaina*" & Range("B1").Value End If End Sub
You’ll need to create a calculated field called
ScaledField (or give it your own name – just change the code too) and you might want to change the formula if you don’t want to scale
[Kaina], but something else.
PS. If the value isn’t
[Kaina Sausis] then the formula would require single quotes to wrap the field name:
StandardFormula = "='Kaina Sausis'*" & Range("B1").Value
Manipulating the value of data fields directly in the pivot table is not possible (try to manually change a value or with VBA and you get an error message).
It’s possible to overwrite values of row fields, but that’s a bit strange (they will stay like this after and not update anymore unless you by coincidence entered a valid value).
For calculations you can add a calculated field. If the value is constant and the value doesn’t need to be taken from a Range just add a calculated field manually (Analyze > Fields … > Calculated Field…) and enter the constant value in the formula.
Unfortunately calculated fields cannot reference ranges so if you really have to use the value from a Range in the formula of the calculated field you can use this VBA code (it adds a calculated field or updates the formula if the field already exists, that would be of use if the value is not constant):
' You prolly have to call this only once as you are using a constant value. ' If not add to your worksheet change event ' Modify hardcoded values if needed Sub createOrUpdateField() Dim fldFormula As String ' Construct the formula to use fldFormula = "= Kaina Sausis / " & ActiveSheet.Range("B1").Value2 addOrUpdateCalculatedField _ ActiveSheet.PivotTables(1), _ "Kaina Sausis Calc", fldFormula, "0.00" End Sub ' In case you want to remove the calculated field use this ' Or use the interface (Analyze > Fields ... > Calculated Field...) Sub deleteField() pt.PivotFields("Kaina Sausis Calc").Delete End Sub ' Add a calculated field to pivot table or update formula if it already exists. ' Args: ' pt (PivotTable): The pivot table object ' fldName (String): Name to use for the field ' fldFormula (String): Formula to use for calculation ' fldFormat (String): Number format to use Sub addOrUpdateCalculatedField(pt As PivotTable, fldname As String, _ fldFormula As String, fldFormat As String) Dim wks As Worksheet Dim ptfld As PivotField ' Try to reference the field to check if it already exists On Error Resume Next Set ptfld = pt.PivotFields(fldname) On Error GoTo 0 If ptfld Is Nothing Then ' Field doesn't exist, add it Set ptfld = pt.CalculatedFields.Add(name:=fldname, formula:=fldFormula) With ptfld .Caption = fldname .NumberFormat = fldFormat .Orientation = xlDataField .Function = xlSum End With Else ' Field already exists, change the formula only ptfld.StandardFormula = fldFormula End If Set wks = Nothing Set pt = Nothing Set ptfld = Nothing End Sub