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

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