Pythagoras in a keypress form

Hi. I am trying to create a form that calculates Pythagoras's Theorem, the rest of this post gets a bit complicated so I have tried to reduce the problem, to make it easier to work out. You could ignore this post and go on to the next post just below...

a squared + b squared = c squared
a^2 + b^2 = c^2.

\1

where c is the hypotenuse of a right-angled triangle (the longest side, which is directly opposite the right-angle)

and a and b are the other 2 sides (known as the adjacent and the opposite)

I have created a userform with 3 main TextBoxes known as: Adjacent, Opposite and Hypotenuse.

I want the form to work so that if someone types in values for the opposite and the adjacent sides e.g. 3 and 4, then the form will automatically calculate the hypotenuse, (in this case 5), without anyone having to click any buttons.

I can do this with this code:

Sub Calculate_Hypotenuse()

If Opposite = "" Then Opposite = 0
If Adjacent = "" Then Adjacent = 0
OppositeSquared = Opposite * Opposite
AdjacentSquared = Adjacent * Adjacent

HypotenuseSquared = OppositeSquared * 1 + AdjacentSquared * 1 'I had to put * 1 in here or else it goes doo-lally

Range("A1") = HypotenuseSquared
Range("A2").FormulaR1C1 = "=Sqrt(R[-1]C)" 'Square root the HypotenuseSquared variable to get the Hypotenuse.
Hypotenuse = Range("A2")

End Sub
Private Sub Opposite_Change()

If Opposite = "" Then Opposite = 0
Call Calculate_Hypotenuse

End Sub
Private Sub Adjacent_Change()

If Adjacent = "" Then Adjacent = 0
Call Calculate_Hypotenuse

End Sub

However, being greedy, I also want the form to automatically count the opposite side, when someone types in the adjacent and the hypotenuse. This is where it started going wrong. I tried adding this code but the computer hates it, and almost spat at me.

Private Sub Hypotenuse_Change()

If Hypotenuse = "" Then Hypotenuse = 0

HypotenuseSquared = Hypotenuse * Hypotenuse
AdjacentSquared = HypotenuseSquared - OppositeSquared

'If the HypotenuseSquared is less than the OppositeSquared then the AdjacentSquared will be a negative number, which is bad news for square roots so this next line stops that.
If AdjacentSquared < 0 Then AdjacentSquared = AdjacentSqaured * -1

Range("A2") = AdjacentSquared
Range("A1").FormulaR1C1 = "=Sqrt(R[-1]C)"
Opposite = Range("A1")

End Sub

I don't what I am doing wrong. Please help!

Ok, sorry, that lot above is complicated. Let me reduce it down to something really straightforward.

I have 3 textboxes called a, b and c. Each textbox contains a number. If any of these changes, I need a calculation to be carried out automatically.

Private Sub a_Change()

c = a + b 'if a changes add it to b and put the answer in c

End Sub
Private Sub b_Change()

c = a + b 'if b changes add it to a and put the answer in c

End Sub
Private Sub c_Change()

b = c - a 'if c changes subtract a and put the answer in b

End Sub


Note 1: There are no dims. i don't see the point of these, but maybe there is a point.
Note 2: The number of error messages that this little arrangement can produce is huge. Try it. Try to get it to work. It will drive you loopy. You fix one thing and another error message pops up for no reason whatsoever. You fix that and another error message pops up. Or strange numbers appear for no reason whatsoever.

e.g. according to my form 3+3.33333 = 33.333 (it is concatenating for some reason)

solution: stick *1 everywhere

response: type mismatch (I think that empty textboxes aren't good when trying to do calculations)

solution: insert if a = "" then a = 0, if b = "" then b = 0, if c = "" then c = 0
everywhere, then run form and try to put 3 in textbox a.

response: -3 appears in textbox b, 0 appears in textbox c (c is empty so c becomes = 0(because of the if command I just put in the code), however this change triggers b = c - a )

solution: try using userform_initialize to place a number in a, b and c so it doesn't try to replace the "" with 0's.

ok now it works fine. I'm going back to pythagoras. Might have to change the whole thread in a minute.

Well that's interesting, what your suggesting - I can see how it could help.

Especially if one sub automatically changes textbox3 and then this triggers the textbox3_change sub which changes textbox2 which triggers the textbox2_change sub which changes textbox3 which triggers the textbox3_change sub etc.

Your code would stop that, I think, so thank you very much.

So now I have got the easier 2nd version nailed really. Unfortunately, when I ramp up the complexity so the form can deal with Pythagoras's Theorem, even though I am including your code, I get a strange problem where the TextBox2 constantly has 0 in it.

The easier version says:
If Textbox1 changes then TextBox3 = TextBox1 + TextBox2
If Textbox2 changes then TextBox3 = TextBox1 + TextBox2
If Textbox3 changes then TextBox2 = TextBox3 - TextBox1

The Pythagoras code says:
If TextBox1 changes then TextBox 3 = the square root of:
(TextBox1 * TextBox1) + (TextBox2 * TextBox2)

If TextBox2 changes then TextBox 3 = the square root of:
(TextBox1 * TextBox1) + (TextBox2 * TextBox2)

If TextBox3 changes then TextBox 2 = the square root of:
(TextBox3 * TextBox3) - (TextBox1 * TextBox1)

One problem I had was that the textboxes couldn't handle the delete key being pressed because if the textbox was empty then it would produce a type mismatch error.

To get round this I included this code in each of the 3 textbox_change() subs:
If TextBox1 = "" Then TextBox1 = 0
If TextBox2 = "" Then TextBox2 = 0
If TextBox3 = "" Then TextBox3 = 0

Maybe that is what is causing TextBox2 to permanently remain on 0???

I think I should remove the square roots and thereby try and create an intermediate version that is more complex than the easy version but not as complex as the Pythagorean version. Maybe that will isolate the problem.

Oh, I made an error. Maybe your code has fixed the Pythagorean form as well.

It's an elegant solution and it works. Thank you very much Mudraker.

I haven't been using macros very long but those are 2 things I really notice about programming in Excel: 1) doing something on a worksheet is not the same as doing it in a form 2) things that seem like they might be simple, are often hard, mostly because there is no explanation whatsoever except from kind people in forums.

But anyway I am quite content. I have an even bigger formula which was doing my head in but now I am going to try and nail it. Thanks for your help.

If I may, here is the completed code for the Pythagorean form:

'This macro should be added to a form with 3 textboxes called a b and c
'It uses Pythagoras's Theorem to work out the hypotenuse length of a right-angled triangle.
'The hypotenuse length is represented by c. The adjacent sides' length is represented by a.
'b represents the opposite sides' length.

'The form will take a and b, add the squares and square root to get c.
'square root of ( a^2 + b^2 ) = c

'Or, if c changes it will take whatever is in textbox a, square it, subtract the answer from the
'square of c and then square root - this leaves b.
'square root of ( c^2 - a^2 ) = b

Dim bUpDate As Boolean
'The whole bUpDate thing is provided by Mudraker and overcomes several problems that arise when e.g.
'the variable b is changed, which triggers the sub b_Change() which changes the variable c, which
'triggers the sub c_Change() which changes b which triggers the sub b_Change()...etc.

Sub Calculate_c()

aSquared = a * a
bSquared = b * b
cSquared = aSquared * 1 + bSquared * 1' ' ' 'I had to put: * 1 in here or else it concatenates (i.e joins together)
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' 'aSquared and bSquared. Maybe could overcome using Dim?
Range("A1") = cSquared
Range("A2").FormulaR1C1 = "=Sqrt(R[-1]C)" ' ' ''This square roots cSquared and puts the answer in cell A2.
c = Range("A2") ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' 'There is no? VB version of Sqrt as far as I know, so it
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '' ' ' ' ' ' ' ' ' ' 'has? to take place on a worksheet.
End Sub
Private Sub a_Change()

If bUpDate = False Then
bUpDate = True
If a = "" Then a = 0 ' ' 'If a, b, or c is empty then any attempt to calculate on it, results in
If b = "" Then b = 0 ' ' 'a type mismatch error. To overcome this, any empty textbox is
If c = "" Then c = 0 ' ' 'automatically filled with a zero.

Call Calculate_c ' ' ' ' 'a_Change() and b_Change() do the same thing really. Instead of writing
bUpDate = False' ' ' ' 'Calculate_c out twice, I have stuck it in a separate sub, where it is
End If' ' ' ' ' ' ' ' ' ' ' ' ' 'invoked using this Call statement. I used all the time I saved to write out
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ''this remark.
End Sub
Private Sub b_Change()

If bUpDate = False Then' ' 'When any _change() sub is calculating, bUpDate = True.
bUpDate = True ' ' ' ' ' ' 'As long as bUpDate = True then no other _change() sub can run at all.
If a = "" Then a = 0 ' ' ' 'This effectively stops _change() subs from running within other
If b = "" Then b = 0 ' ' ' '_change() subs, which in turn stops infinite change problems.
If c = "" Then c = 0
Call Calculate_c
bUpDate = False
End If

End Sub
Private Sub c_Change()

If bUpDate = False Then
bUpDate = True
If a = "" Then a = 0
If b = "" Then b = 0
If c = "" Then c = 0

aSquared = a * a
cSquared = c * c
bSquared = cSquared - aSquared
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ''Square rooting negative numbers is not allowed.
If bSquared < 0 Then bSquared = bSquared * -1''' ' 'To stop such behaviour this line <-- turns any
Range("A1") = bSquared ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' 'negative number into it's positive counterpart,
Range("A2").FormulaR1C1 = "=Sqrt(R[-1]C)" ' ' ' ' ' ' 'e.g. -5 is multiplied by -1 to become 5.
b = Range("A2")

bUpDate = False
End If
End Sub