VBA to allow user to change either of two cells and have formula automatically update in both

[J00490]

I have a spreadsheet for pricing items where I have a formula to calculate the total discount in one cell and total price in another. in this state they don't reference each other, just provide the answer.
I want to allow users to overwrite either of these cells and have the formula change to reflect this.
e.g.
Let's assume that the total price was £100 and the total discount 0% at the start.
1. I want to allow users to overwrite the calculated discount cell with, say 10%, this then changes the total price cell to reflect a 10% discount (£90),
2. Alternatively, they could change the total price cell to £90 and the discount cell would update to reflect the 10% change.
If either of the cells are then cleared/deleted, I want the original formulas to come back and show the £100, 0% that was originally calculated.

I know it's possible with VBA, I just don't know how!

 

[Snakehips]

@J00490

Maybe something like the below?
Using the test data:

MRXLMAY21.xlsm
	A	B	C	D	E	F	G	H
1	Total Price	Total Disc		Prc1	Prc2	Prc3	Disc1	Disc2
2	100	10.00%		30	50	20	0	10
3
Sheet1

Cell Formulas
Range	Formula
A2	A2	=D2+E2+F2
B2	B2	=(G2+H2)/100

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub

Dim TotPrice As Range
Dim TotDisc As Range
Dim Ex As String

Set TotPrice = Range("A2")  '<<Edit ranges to suit
Set TotDisc = Range("B2")   '<<Edit ranges to suit

If Not Intersect(Target, TotPrice) Is Nothing Then Ex = "Price"
If Not Intersect(Target, TotDisc) Is Nothing Then Ex = "Disc"
If Ex = vbNullString Then Exit Sub

Application.EnableEvents = False

PriceForm = "=D2+E2+F2"   '<<Edit formula to suit
DiscForm = "=(G2+H2)/100"   '<<Edit formula to suit


If Not Left(Target.Formula, 1) = "=" Then   'Formula has been overwritten

    If Target.Value = vbNullString Then  'reset original formulas
        TotPrice.Formula = PriceForm
        TotDisc.Formula = DiscForm
        Application.EnableEvents = True
        Exit Sub
    End If
    
    
    
    Select Case Ex
        Case "Price"
        'Use below formula if initial discount is always 0%
           ' TotDisc = 1 - (TotPrice / (Evaluate(PriceForm)))
        'Otherwise this below??????
            TotDisc = 1 - (TotPrice / (Evaluate(PriceForm))) + Evaluate(DiscForm)
        
        Case "Disc"
         'Use below formula if initial discount is always 0%
            TotPrice = (1 - TotDisc) * Evaluate(PriceForm)
           'Otherwise this below??????
            'TotPrice = (1 - (TotDisc - Evaluate(DiscForm))) * Evaluate(PriceForm)
            
    End Select



End If
Application.EnableEvents = True
End Sub

Give that a test. I'm not sure which of the alternative expressions you would want to use. Maybe the second if your relationship is taking into account the initial discount?

Hope that helps.