Changing up to 2 of 3 vals and the 3rd val is automatically Calcul

[monir]

Hello;

Below is a brief description of the problem and the code:

There's a starting value in Each of the UNLOCKED cells C12, C14, C16.

The purpose of the w/s Change event is (3 scenarios for now):
....If the value in cell C12 is changed manually, cell C16 is automatically
calculated
....If the value in cell C14 is changed manually, cell C16 is automatically
calculated
....If the value in cell C16 is changed manually, cell C14 is automatically
calculated

The manually changed values are displayed in dark yellow fill.

====================================
Private Sub Worksheet_Change(ByVal Target As Range)
Const sInputCells = "C12,C14,C16"
' manually input ANY 2 of C12, C14, C16 values and the 3rd is automatically
calculated
' and displayed in light green fill

With Target
If Not Intersect(.Cells, Range(sInputCells)) Is Nothing Then
If .Column = 3 Then
On Error GoTo ErrHandler
Application.EnableEvents = False
If .Row = 12 Then 'calc C16
.Interior.ColorIndex = 6
.Offset(2, 0).Interior.ColorIndex = 6
.Offset(4, 0).Interior.ColorIndex = 35
.Offset(4, 0).Formula = "=E12*C19*60/C9/C14"
ElseIf .Row = 14 Then 'calc C16
.Interior.ColorIndex = 6
.Offset(-2, 0).Interior.ColorIndex = 6
.Offset(2, 0).Interior.ColorIndex = 35
.Offset(2, 0).Formula = "=E12*C19*60/C9/C14"
ElseIf .Row = 16 Then 'calc C14
.Interior.ColorIndex = 6
.Offset(-4, 0).Interior.ColorIndex = 6
.Offset(-2, 0).Interior.ColorIndex = 35
.Offset(-2, 0).Formula = "=E12*C19*60/C9/C16"
End If
End If
End If
End With
ErrHandler:
Application.EnableEvents = True
End Sub
====================================

With unprotected sheet and only the above w/s Change event in effect ( XL
2003 Options: 1,000 Iterations, Max. change 0.00001, though not really
needed!):
1) procedure works fine by manually changing the values in C14 and/or C16
2) procedure works fine by manually changing the value in C12 provided the
preceding manual change(s) was in C14
3) procedure FAILS when manually changing the value in C12 if the preceding
manual change(s) was in C16.

So it seems to me that the problem (circular ref., 0.00 or DIV/0!) is most
certainly with the above Change event code.

I would be glad to attach the simple test w/b (single w/s), if I only know
how !!
Your help in identifying the problem would be greatly appreciated.
Thank you kindly.

 

[Barb Reinhardt]

It looks to me like you're going to have a circular reference in a couple of
cases. Try this

Private Sub Worksheet_Change(ByVal Target As Range)
Const sInputCells = "C12,C14,C16"
' manually input ANY 2 of C12, C14, C16 values and the 3rd is automatically
' calculated
' and displayed in light green fill
Dim myVal

With Target
If Not Intersect(.Cells, Range(sInputCells)) Is Nothing Then
If .Column = 3 Then
On Error GoTo ErrHandler
Application.EnableEvents = False
If .Row = 12 Then 'calc C16
.Interior.ColorIndex = 6
.Offset(2, 0).Interior.ColorIndex = 6
.Offset(4, 0).Interior.ColorIndex = 35
myVal = Me.Range("E12").Value2 & Me.Range("C19").Value2 _
* 60 / Me.Range("C9").Value2 / Me.Range("C14").Value2
.Offset(4, 0).Value2 = myVal
ElseIf .Row = 14 Then 'calc C16
.Interior.ColorIndex = 6
.Offset(-2, 0).Interior.ColorIndex = 6
.Offset(2, 0).Interior.ColorIndex = 35
myVal = Me.Range("E12").Value2 & Me.Range("C19").Value2 _
* 60 / Me.Range("C9").Value2 / Me.Range("C14").Value2
.Offset(2, 0).Value2 = myVal
ElseIf .Row = 16 Then 'calc C14
.Interior.ColorIndex = 6
.Offset(-4, 0).Interior.ColorIndex = 6
.Offset(-2, 0).Interior.ColorIndex = 35
myVal = Me.Range("E12").Value2 & Me.Range("C19").Value2 _
* 60 / Me.Range("C9").Value2 / Me.Range("C16").Value2
.Offset(-2, 0).Value2 = myVal

End If
End If
End If
End With
ErrHandler:
Application.EnableEvents = True
End Sub




--
HTH,
Barb Reinhardt

If this post was helpful to you, please click YES below.

 

[monir]

Hi Barb;

Thank you for your help and your clever way of avoiding the circular ref.
problem.
(There's a typo in your myVal statements. I've replaced "&" with "*".)

The procedure now works fine and as desired, yet there's consequential
problem resulting from NOT returning the formula into cell C14 or C16; as the
case maybe. Let me explain.
The formula as coded in my OP contains two additional dependent parameters
(in cells C9 and C19), which are not part of the w/s Change procedure. If
the value in either C9 or C19 is changed, then now by NOT returning the
formula by the Change event procedure to cell C14 or C16 (as the case maybe),
its value would not be updated. Problem !

In other words, if the value in C9 or C19 is changed, then wherever the
value of the "formula with light green fill" was returned LAST by the w/s
Change event should be updated accordingly. But, how to do that without
disrupting the code??

My description of the problem sounds a bit confusing. My apologies!

Regards.

 

[monir]

Hi Barb;

Here's one possible solution.

The w/s Change procedure (as listed in my OP) returns a formula to either
cell C14 or C16. To avoid the circ. ref. error, here's what I did. Before
returning the formula to, say C16, I replaced the formula in C14, if any, by
the formula's value, using copy/paste value. Did the same when calculating
C14 by replacing the formula, if any, in cell C16 by its value.

This may not be the ideal way of doing it for an expert like you, but it
works!

===============================================
Private Sub Worksheet_Change(ByVal Target As Range)
'manually input ANY 2 of C12, C14, C16 values and automatically calculate
the 3rd
Const sInputCells = "C12,C14,C16"

With Target
If Not Intersect(.Cells, Range(sInputCells)) Is Nothing Then
If .Column = 3 Then
On Error GoTo ErrHandler
Application.EnableEvents = False
If .Row = 12 Then 'calc C16
.Interior.ColorIndex = 6
.Offset(2, 0).Interior.ColorIndex = 6
.Offset(2, 0).Copy
.Offset(2, 0).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Offset(4, 0).Interior.ColorIndex = 35
.Offset(4, 0).Formula = "=E12*C19*60/C9/C14"
ElseIf .Row = 14 Then 'calc C16
.Interior.ColorIndex = 6
.Offset(-2, 0).Interior.ColorIndex = 6
.Offset(2, 0).Interior.ColorIndex = 35
.Offset(2, 0).Formula = "=E12*C19*60/C9/C14"
ElseIf .Row = 16 Then 'calc C14
.Interior.ColorIndex = 6
.Offset(-4, 0).Interior.ColorIndex = 6
.Offset(-4, 0).Copy
.Offset(-4, 0).PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Offset(-2, 0).Interior.ColorIndex = 35
.Offset(-2, 0).Formula = "=E12*C19*60/C9/C16"
End If
End If
End If
End With
ErrHandler:
Application.EnableEvents = True
Application.CutCopyMode = False
End Sub
===============================================

The initial less-serious problem remains however. That's, with cells C9,
C12, C14, C16, C19 unlocked, the above procedure partially fails if the w/s
is protected. I may have to live with it!

Regards.

 

[monir]

Hi;

For those who might be interested, here's an easy fix to protect cells with
formulas on the same w/s. Those cells are LOCKED on the unprotected sheet.
In addition to the w/s Change event (last posted), the following w/s
SelectionChange event is added. It protects those cells without the need to
protect the entire sheet, and thus avoiding the w/s protection problem
highlighted earlier.
The SelectionChange procedure is based on (MrExcel) nigelk's reply posted
earlier, but modified to suit.
==============================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'It protects cells that have a formula without the need to protect the whole
sheet.

Dim rng As Range
Const sInputCells = "C12,C14,C16"

With Target
If Intersect(.Cells, Range(sInputCells)) Is Nothing Then
For Each rng In .Cells
If rng.HasFormula Then
ActiveSheet.Protect
Exit Sub
Else
ActiveSheet.Unprotect
End If
Next rng
Else
ActiveSheet.Unprotect
End If
End With
End Sub
==============================
Regards.