How to divide all values in a pivot table column by a constant

Question

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

Answer 1

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] , but [Kaina Sausis] then the formula would require single quotes to wrap the field name:

StandardFormula = "='Kaina Sausis'*" & Range("B1").Value

Answer 2

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