Private Sub Worksheet_Change(ByVal Target As Range)
Dim Budget, Bank1 As Range, Bank2 As Range, Bank3 As Range
Dim Percent1 As Range, Percent2 As Range, Percent3 As Range
Set Budget = Range("B5")
Set Bank1 = Range("C5")
Set Bank2 = Range("D5")
Set Bank3 = Range("E5")
Set Percent1 = Range("C6")
Set Percent2 = Range("D6")
Set Percent3 = Range("E6")
Select Case Target.Address
Case Bank1.Address
If InStr(1, Bank1.Formula, "$B$5") = 0 Then
Bank2.Formula = "=" & Budget.Address & "*" & Percent2.Address
Bank3.Formula = "=" & Budget.Address & "*" & Percent3.Address
With Percent1
.Interior.ColorIndex = 0
.Formula = "=" & Bank1.Address & "/" & Budget.Address
With .Validation
.Delete
.Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, _
Operator:=xlEqual, Formula1:=Percent1.Value
.ErrorTitle = "Invalid Overwrite"
.ErrorMessage = "You cannot overwrite this percentage"
End With
End With
With Percent2
.Formula = "=(1 - " & Percent1.Address & ") / 2"
.Interior.ColorIndex = 6
.Validation.Delete
End With
With Percent3
.Formula = "=(1 - " & Percent1.Address & ") / 2"
.Interior.ColorIndex = 6
.Validation.Delete
End With
End If
Case Bank2.Address
If InStr(1, Bank2.Formula, "$B$5") = 0 Then
Bank1.Formula = "=" & Budget.Address & "*" & Percent1.Address
Bank3.Formula = "=" & Budget.Address & "*" & Percent3.Address
With Percent2
.Interior.ColorIndex = 0
.Formula = "=" & Bank2.Address & "/" & Budget.Address
With .Validation
.Delete
.Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, _
Operator:=xlEqual, Formula1:=Percent2.Value
.ErrorTitle = "Invalid Overwrite"
.ErrorMessage = "You cannot overwrite this percentage"
End With
End With
With Percent1
.Formula = "=(1 - " & Percent2.Address & ") / 2"
.Interior.ColorIndex = 6
.Validation.Delete
End With
With Percent3
.Formula = "=(1 - " & Percent2.Address & ") / 2"
.Interior.ColorIndex = 6
.Validation.Delete
End With
End If
Case Bank3.Address
If InStr(1, Bank3.Formula, "$B$5") = 0 Then
Bank1.Formula = "=" & Budget.Address & "*" & Percent1.Address
Bank2.Formula = "=" & Budget.Address & "*" & Percent2.Address
With Percent3
.Interior.ColorIndex = 0
.Formula = "=" & Bank3.Address & "/" & Budget.Address
With .Validation
.Delete
.Add Type:=xlValidateDecimal, AlertStyle:=xlValidAlertStop, _
Operator:=xlEqual, Formula1:=Percent3.Value
.ErrorTitle = "Invalid Overwrite"
.ErrorMessage = "You cannot overwrite this percentage"
End With
End With
With Percent1
.Formula = "=(1 - " & Percent3.Address & ") / 2"
.Interior.ColorIndex = 6
.Validation.Delete
End With
With Percent2
.Formula = "=(1 - " & Percent3.Address & ") / 2"
.Interior.ColorIndex = 6
.Validation.Delete
End With
End If
End Select
Select Case Target.Address
Case Percent1.Address
If InStr(1, Bank1.Formula, "$B$5") <> 0 And _
(InStr(1, Percent1.Formula, "$D$6") = 0 And _
InStr(1, Percent1.Formula, "$E$6") = 0) Then
If InStr(1, Percent2.Formula, "$B$5") <> 0 Then
Percent3.Formula = "=1 - (" & Percent1.Address & "+" & _
Percent2.Address & ")"
Else
Percent2.Formula = "=1 - (" & Percent1.Address & "+" & _
Percent3.Address & ")"
End If
End If
Case Percent2.Address
If InStr(1, Bank2.Formula, "$B$5") <> 0 And _
(InStr(1, Percent2.Formula, "$D$6") = 0 And _
InStr(1, Percent2.Formula, "$E$6") = 0) Then
If InStr(1, Percent1.Formula, "$B$5") <> 0 Then
Percent3.Formula = "=1 - (" & Percent2.Address & "+" & _
Percent1.Address & ")"
Else
Percent1.Formula = "=1 - (" & Percent2.Address & "+" & _
Percent3.Address & ")"
End If
End If
Case Percent3.Address
If InStr(1, Bank3.Formula, "$B$5") <> 0 And _
(InStr(1, Percent3.Formula, "$D$6") = 0 And _
InStr(1, Percent3.Formula, "$E$6") = 0) Then
If InStr(1, Percent1.Formula, "$B$5") <> 0 Then
Percent2.Formula = "=1 - (" & Percent3.Address & "+" & _
Percent1.Address & ")"
Else
Percent1.Formula = "=1 - (" & Percent3.Address & "+" & _
Percent2.Address & ")"
End If
End If
End Select
End Sub