Another UF question -SOLVED!!!!!

[mortgageman]

Okay here we go again :wink:

In the ongoing saga that is the WIP of my daughters HW helper, I have just added a Inverse Matrix. What I do is present the elements of the matrix in TextBoxes. By default, the results are shown in decimal. What I would like to have is a button on the UF that would allow the user to toggle between decimal format and fraction format. Is this out of this world difficult or just mildly so?

TIA for any help anyone offers

Gene, "The Mortgage Man", Klein

 

[Legacy 98055]

Same as Joe's but more event driven...

Dec2Fract.zip

<table width="100%" border="1" bgcolor="White" style="filterrogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD><font size="2" face=Courier New>  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> CommandButton1_Click()
       <font color="#0000A0">If</font> CommandButton1.Caption = "Fraction" <font color="#0000A0">Then</font>
           TextBox1.Text = Application.WorksheetFunction.Text(CDbl(TextBox1.Tag), "# ??/??")
           CommandButton1.Caption = "Decimal"
       <font color="#0000A0">Else</font>
           TextBox1.Text = Format(CDbl(TextBox1.Tag), "#,##0.000")
           CommandButton1.Caption = "Fraction"
       <font color="#0000A0">End</font> <font color="#0000A0">If</font>
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>

  <font color="#0000A0">Private</font> <font color="#0000A0">Sub</font> TextBox1_Change()
       <font color="#0000A0">If</font> IsNumeric(TextBox1) <font color="#0000A0">Then</font> TextBox1.Tag = TextBox1.Value
  <font color="#0000A0">End</font> <font color="#0000A0">Sub</font>
</FONT></td></tr></table><button onclick='document.all("914200614342484").value=document.all("914200614342484").value.replace(/<br \/>\s\s/g,"");document.all("914200614342484").value=document.all("914200614342484").value.replace(/<br \/>/g,"");window.clipboardData.setData("Text",document.all("914200614342484").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="914200614342484" wrap="virtual">
Private Sub CommandButton1_Click()
If CommandButton1.Caption = "Fraction" Then
TextBox1.Text = Application.WorksheetFunction.Text(CDbl(TextBox1.Tag), "# ??/??")
CommandButton1.Caption = "Decimal"
Else
TextBox1.Text = Format(CDbl(TextBox1.Tag), "#,##0.000")
CommandButton1.Caption = "Fraction"
End If
End Sub

Private Sub TextBox1_Change()
If IsNumeric(TextBox1) Then TextBox1.Tag = TextBox1.Value
End Sub</textarea>

Dec2Fract.zip

 

[mortgageman]

Thank you both!!!!


Tom - if I use your way, do I have to "Initialize" the commandbutton caption with either "Fraction" or "Decimal"?


Gene, "The Mortgage Man", Klein

 

[Joe Was]

Tom, Cannot get your code to convert a number entered as a fraction in the textbox to a decimal format, if it is in the mode wanting a decimal and for the opposit.

Edited and added after the post above: Testsed some more, the problem with the code is its detection is not automatic for input. If you enter the data in the wrong format for the caption state on the button the code does not work.

Doing it the long way as in my code, it automatically detects any data input format and reacts accordingly. That is why my code is so much longer.

But, yes if you follow the button caption and format your data to be compatable with that caption, upon your data entery, then your code is better and more compact.

 

[Legacy 98055]

I assumed that the control's value would be initialized using a decimal.

 

[mortgageman]

Tom - I tried yours first and it almost worked. Here was the behavior:

The textbox has the decimal in it (.2) and the command button has the caption Decimal (which IMHO is kinda strange - since you want to change TO fraction. When I press the command button, the actual decimal changes to .200 and the command button changes to Fraction. From there on it works perfectly.

Gene, "The Mortgage Man", Klein

P.S. How do you attach your code with the paste to clipboard right below it?

 

[mortgageman]

I used Joe's and it worked. Now I have another related problem. Since I have more than one text box in the inverse matrix (at least 4 textboxes)
I put all of Joe's code into a function called:

Private Sub togglefracdec(tb As TextBox)

then made 4 calls to it like this:
togglefracdec(textbox21)
togglefracdec(textbox22)
etc

VBA DIDN'T LIKE THAT AT ALL. Bombed out straight away on the first call to togglefracdec.

Any ideas as to what I did wrong?

Gene, "The Mortgage Man", Klein

 

[Legacy 98055]

Gene. I would have to see your code.

P.S. How do you attach your code with the paste to clipboard right below it?

A homegrown app.

 

[mortgageman]

Tom - First I appreciate the help. Thanks. Here is the relevant code.
(On the small chance that all the code might be of use, I will post it all in a seperate post)

Gene, "The Mortgage Man", Klein


Private Sub CommandButton1_Click()
Call togglefracdec(TextBox21)
Call togglefracdec(TextBox22)
Call togglefracdec(TextBox24)
Call togglefracdec(TextBox25)
End Sub

Private Sub togglefracdec(tb As TextBox)
Dim myVal$, myNum$, myDenom$
Dim myNumLen%, myCnt%
Dim myValResult As Variant

On Error GoTo myOther

myVal = tb.Value
myNumLen = Application.WorksheetFunction.Search("/", myVal)
myNum = Left(myVal, myNumLen - 1)
myCnt = Len(myVal)
myDenom = Right(myVal, myCnt - myNumLen)
myValResult = myNum / myDenom

tb.Value = Application.WorksheetFunction.Text(myValResult, "#,##0.000")
GoTo myEnd

myOther:
myVal = tb.Value
tb.Value = Application.WorksheetFunction.Text(myVal, "# ??/??")

myEnd:
End Sub

 

[mortgageman]

Tom (or Joe or anyone else) here is all the code: (It still is a WIP - so try not to laugh too much)

Gene, "The Mortgage Man", Klein



Option Explicit


Private Sub Userform_Initialize()
Dim i As Integer
TwoEquationsText = "Solve for Two Equations"
ThreeEquationsText = "Solve For Three Equations"

'Don't show results stuff until we know which option user picks (2 vars or 3)
PerpLines.Visible = False
xanslabel.Visible = False
yanslabel.Visible = False
zanslabel.Visible = False
xansuf.Visible = False
yansuf.Visible = False
zansuf.Visible = False
Image1.Visible = False
For i = 1 To 4
Me.Controls("Label" & i).Visible = False
Next i

For i = 17 To 20
Me.Controls("TextBox" & i).Visible = False
Next i

'Inverse Matrix
For i = 21 To 29
Me.Controls("TextBox" & i).Visible = False
Next i
'Inverse Matrix Label
Label5.Visible = False

End Sub
Private Sub OptionButton1_Change()
Dim i As Integer

If OptionButton1 Then
'shut off boxes that the three equations use
For i = 1 To 16
Me.Controls("TextBox" & i).Visible = False
Next i
For i = 1 To 3
Me.Controls("Label" & i).Visible = True
Next i
Label4.Visible = False
For i = 17 To 19
Me.Controls("TextBox" & i).Visible = True
Next i
TextBox20.Visible = False
TextBox17 = ""
TextBox18 = ""
TextBox19 = ""

'Clear anything that may be in Inverse Matrix Textboxes
'and don't display the 3 var boxes
TextBox21 = ""
TextBox22 = ""
TextBox23 = ""
TextBox24 = ""
TextBox25 = ""
TextBox26 = ""
TextBox27 = ""
TextBox28 = ""
TextBox29 = ""

TextBox23.Visible = False
TextBox26.Visible = False
For i = 27 To 29
Me.Controls("TextBox" & i).Visible = False
Next i

'make sure inverse boxes for two vars (and label) are visible
TextBox21.Visible = True
TextBox22.Visible = True
TextBox24.Visible = True
TextBox25.Visible = True
Label5.Visible = True





'Set up text in boxes for 2 equations
Call SetUpUfFor2
End If
End Sub
Private Sub OptionButton2_Click()
Dim i As Integer

If OptionButton2 Then
'turn on boxes that the three equations use
For i = 1 To 16
Me.Controls("TextBox" & i).Visible = True
Next i

For i = 1 To 4
Me.Controls("Label" & i).Visible = True
Next i
For i = 17 To 20
Me.Controls("TextBox" & i).Visible = True
Next i
TextBox17 = ""
TextBox18 = ""
TextBox19 = ""
TextBox20 = ""

'Set up text in boxes for 2 equations
Call SetUpUfFor3

End If
End Sub
Private Sub GoButton_Click()


'Make sure user has picked one of the two option buttons
If Not (OptionButton1 Or OptionButton2) Then
MsgBox "First Choose to Solve 2 or 3 Equations"
Exit Sub
End If

If OptionButton1 Then Call ThingsToDoFor2
If OptionButton2 Then Call ThingsToDoFor3

End Sub
Private Function oknumvals() As Boolean
Dim allvalues As Boolean
allvalues = IsNumeric(Eq1xcoff) And IsNumeric(Eq1ycoff) And IsNumeric(eq2xcoff)
allvalues = allvalues And IsNumeric(eq2ycoff) And IsNumeric(Eq1const)
oknumvals = allvalues And IsNumeric(eq2const)
End Function
Private Sub SetUpUfFor2()
Eq1x = "X"
Eq1y = "Y"
eq2x = "X"
eq2y = "Y"
Eq1plus = "+"
eq2plus = "+"
Eq1equals = "="
eq2equals = "="
Eq1xcoff = ""
Eq1ycoff = ""
Eq1const = ""
eq2xcoff = ""
eq2ycoff = ""
eq2const = ""
xanslabel = "X="
yanslabel = "Y="
xanslabel.Visible = False
yanslabel.Visible = False
zanslabel.Visible = False
xansuf.Visible = False
yansuf.Visible = False
zansuf.Visible = False
Eq1equals.TabStop = False
eq2equals.TabStop = False
PerpLines.Value = ""
PerpLines.Visible = False
End Sub
Private Sub SolveSystemEq2()
Dim dCoefficients(1 To 2, 1 To 2) As Double
Dim dAdet, dXdet, dYdet As Double
Dim dIndTerms(1 To 2, 1 To 1) As Double
Dim vResults
Dim dInverse

dCoefficients(1, 1) = Val(Eq1xcoff.Value)
dCoefficients(1, 2) = Val(Eq1ycoff.Value)
dCoefficients(2, 1) = Val(eq2xcoff.Value)
dCoefficients(2, 2) = Val(eq2ycoff.Value)

'Calculate the inverse matrix
dInverse = Application.WorksheetFunction.MInverse(dCoefficients)

'Put the elements in the right boxes
TextBox21 = dInverse(1, 1)
TextBox22 = dInverse(1, 2)
TextBox24 = dInverse(2, 1)
TextBox25 = dInverse(2, 2)

dIndTerms(1, 1) = Val(Eq1const.Value)
dIndTerms(2, 1) = Val(eq2const.Value)

With Application.WorksheetFunction
vResults = .MMult(.MInverse(dCoefficients()), dIndTerms())
dAdet = .MDeterm(dCoefficients)
dCoefficients(1, 1) = dIndTerms(1, 1)
dCoefficients(2, 1) = dIndTerms(2, 1)
dXdet = .MDeterm(dCoefficients)
dCoefficients(1, 1) = Val(Eq1xcoff.Value)
dCoefficients(2, 1) = Val(eq2xcoff.Value)
dCoefficients(1, 2) = dIndTerms(1, 1)
dCoefficients(2, 2) = dIndTerms(2, 1)
dYdet = .MDeterm(dCoefficients)
End With



xansuf = vResults(1, 1)
yansuf = vResults(2, 1)
TextBox17 = dAdet
TextBox18 = dXdet
TextBox19 = dYdet
End Sub

Private Sub ThingsToDoFor2()
Dim allvalues As Boolean
Dim slope1 As Double, slope2 As Double
Dim bint1 As Double, bint2 As Double
Dim line1xarray, line1yarray, line2xarray, line2yarray
Dim Fname
Dim CurrentChart
Dim yval As Double
Dim xint, yint As Double

'Clear All Solutions from previous use
PerpLines.Visible = False
PerpLines = ""
xansuf = ""
yansuf = ""

' check that user has input all numeric values
' Otherwise alert
allvalues = oknumvals
If (Not allvalues) Then
MsgBox allvalues
Exit Sub
End If

' calculate the slopes and y intercepts for the 2 equations
slope1 = -1 * Val(Eq1xcoff.Value) / Val(Eq1ycoff.Value)
slope2 = -1 * Val(eq2xcoff.Value) / Val(eq2ycoff.Value)
bint1 = Val(Eq1const.Value) / Val(Eq1ycoff.Value)
bint2 = Val(eq2const.Value) / Val(eq2ycoff.Value)

' There are two cases:

' First: The lines might be the same (one line is a "multiple" of
' the other
If (slope1 = slope2) And (bint1 = bint2) Then
MsgBox "Both Lines the same!!!"
Exit Sub
End If

' Second - the lines might never intersect
If (slope1 = slope2) And (bint1 <> bint2) Then
MsgBox "No solutions: Parallel lines"
Exit Sub
End If

' If we get past all other issues, then calculate the one solution
' and display if lines are perpendicular - display only if yes
If (slope1 = -1 * (1 / slope2)) Then
PerpLines.Visible = True
PerpLines = "The lines are Perpendicular"
End If

'Solve the system
Call SolveSystemEq2

'Display the solution
xanslabel.Visible = True
yanslabel.Visible = True
xansuf.Visible = True
yansuf.Visible = True

'Generate the Graph

'First clean up any graphs that may already exist:
Charts.Add
ActiveChart.ChartType = xlXYScatterSmooth
Do Until ActiveChart.SeriesCollection.count = 0
ActiveChart.SeriesCollection(1).Delete
Loop


'create the arrays for the inputs to the charts
'Since we have y intercept, 0 is one x value for both
'For 2nd point, use Tusharms good idea of including intersection point in data
line1xarray = Array(0, Val(xansuf.Value))
line1yarray = Array(bint1, Val(yansuf.Value))
line2xarray = Array(0, Val(xansuf.Value))
line2yarray = Array(bint2, Val(yansuf.Value))

'put on line 1
With ActiveChart.SeriesCollection.NewSeries
.Name = "Line 1"
.XValues = line1xarray
.Values = line1yarray
End With

'put on line 2
With ActiveChart.SeriesCollection.NewSeries
.Name = "Line 2"
.XValues = line2xarray
.Values = line2yarray
End With

'Title the Chart
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Where Two Paths Cross"
End With

'put Horizontal and Vertical Gridline
With ActiveChart.Axes(xlCategory)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With
With ActiveChart.Axes(xlValue)
.HasMajorGridlines = True
.HasMinorGridlines = False
End With

'Write the Chart to the spreadsheet
ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"

'Write graph to a file and then read it into the UF image
Set CurrentChart = Sheets("Sheet1").ChartObjects(Sheets("Sheet1").ChartObjects.count).Chart
Fname = ThisWorkbook.Path & "\temp.gif"
CurrentChart.Export Filename:=Fname, Filtername:="GIF"
Image1.Visible = True
Image1.Picture = LoadPicture(Fname)
End Sub

Private Sub SetUpUfFor3()
Eq1x = "X"
Eq1y = "Y"
eq2x = "X"
eq2y = "Y"
Eq1plus = "+"
eq2plus = "+"
Eq1equals = "+"
eq2equals = "+"
Eq1xcoff = ""
TextBox1 = "Z"
TextBox2 = "="
TextBox4 = "Z"
TextBox5 = "="
TextBox6 = ""
TextBox7 = ""
TextBox8 = "X"
TextBox9 = "+"
TextBox10 = ""
TextBox11 = "Y"
TextBox12 = "+"
TextBox13 = ""
TextBox14 = "Z"
TextBox15 = "="
TextBox16 = ""

Eq1ycoff = ""
Eq1const = ""
TextBox3 = ""
eq2xcoff = ""
eq2ycoff = ""
eq2const = ""
xanslabel = "X="
yanslabel = "Y="
zanslabel = "Z="
xanslabel.Visible = False
yanslabel.Visible = False
xansuf.Visible = False
yansuf.Visible = False
Eq1equals.TabStop = True
eq2equals.TabStop = True
Image1.Visible = False
End Sub

Private Sub SolveSystemEq3()
Dim dCoefficients(1 To 3, 1 To 3) As Double
Dim dIndTerms(1 To 3, 1 To 1) As Double
Dim vResults

dCoefficients(1, 1) = Val(Eq1xcoff.Value)
dCoefficients(1, 2) = Val(Eq1ycoff.Value)
dCoefficients(1, 3) = Val(Eq1const.Value)
dCoefficients(2, 1) = Val(eq2xcoff.Value)
dCoefficients(2, 2) = Val(eq2ycoff.Value)
dCoefficients(2, 3) = Val(eq2const.Value)
dCoefficients(3, 1) = Val(TextBox7.Value)
dCoefficients(3, 2) = Val(TextBox10.Value)
dCoefficients(3, 3) = Val(TextBox13.Value)

If (Application.WorksheetFunction.MDeterm(dCoefficients) = 0) Then
MsgBox "Your inputs do not lead to a solution"
Exit Sub
End If

dIndTerms(1, 1) = Val(TextBox3.Value)
dIndTerms(2, 1) = Val(TextBox6.Value)
dIndTerms(3, 1) = Val(TextBox16.Value)

With Application.WorksheetFunction
vResults = .MMult(.MInverse(dCoefficients()), dIndTerms())
TextBox17 = .MDeterm(dCoefficients)
dCoefficients(1, 1) = dIndTerms(1, 1)
dCoefficients(2, 1) = dIndTerms(2, 1)
dCoefficients(3, 1) = dIndTerms(3, 1)
TextBox18 = .MDeterm(dCoefficients)
dCoefficients(1, 1) = Val(Eq1xcoff.Value)
dCoefficients(2, 1) = Val(eq2xcoff.Value)
dCoefficients(3, 1) = Val(TextBox7.Value)
dCoefficients(1, 2) = dIndTerms(1, 1)
dCoefficients(2, 2) = dIndTerms(2, 1)
dCoefficients(3, 2) = dIndTerms(3, 1)
TextBox19 = .MDeterm(dCoefficients)
dCoefficients(1, 2) = Val(Eq1ycoff.Value)
dCoefficients(2, 2) = Val(eq2ycoff.Value)
dCoefficients(3, 2) = Val(TextBox10.Value)
dCoefficients(1, 3) = dIndTerms(1, 1)
dCoefficients(2, 3) = dIndTerms(2, 1)
dCoefficients(3, 3) = dIndTerms(3, 1)
TextBox20 = .MDeterm(dCoefficients)
End With

xansuf = vResults(1, 1)
yansuf = vResults(2, 1)
zansuf = vResults(3, 1)
End Sub


Private Sub ThingsToDoFor3()
Dim f11, f12, f13, f21, f22, f23, f31, f32, f33 As Double
PerpLines.Visible = False
PerpLines = ""
xansuf = ""
yansuf = ""
zansuf = ""
'Check all cases before we let mmult-minverse take over
'Some Analysis comes from following website:
'http://www.josechu.com/planes_in_3d/index.htm#1)

'Equation 1:
'f11 = -1 * Val(Eq1xcoff.Value) / Val(Eq1const.Value)
'f12 = -1 * Val(Eq1ycoff.Value) / Val(Eq1const.Value)
'f13 = -1 * Val(TextBox3.Value) / Val(Eq1const.Value)
'Equation 2:
'f21 = -1 * Val(eq2xcoff.Value) / Val(eq2const.Value)
'f22 = -1 * Val(eq2ycoff.Value) / Val(eq2const.Value)
'f23 = -1 * Val(TextBox6.Value) / Val(eq2const.Value)
'Equation 3:
'f31 = -1 * Val(TextBox7.Value) / Val(TextBox13.Value)
'f32 = -1 * Val(TextBox10.Value) / Val(TextBox13.Value)
'f33 = -1 * Val(TextBox16.Value) / Val(TextBox13.Value)

'Case 1: All three planes are parallel
'If (f11 = f21) And (f11 = f31) And (f12 = f22) And (f12 = f32) And (f13 <> f23) And (f23 <> f33) And (f13 <> f33) Then
' PerpLines.Value = "No solution: All Three Planes are Parallel"
' PerpLines.Visible = True
' Exit Sub
'End If
'Case 2: First two planes are parallel
'If (f11 = f21) And (f12 = f22) And (f13 <> f23) Then
'PerpLines.Value = "No solutions: First Two Planes are Parallel"
'PerpLines.Visible = True
'Exit Sub
'End If
'Case 3: 2nd and Third Planes are Parallel
'If (f21 = f31) And (f22 = f32) And (f23 <> f33) Then
' PerpLines.Value = "No solutions: Last Two Planes are Parallel"
' PerpLines.Visible = True
' Exit Sub
'End If
'Case 4: 1st and 3rd Planes are Parallel
'If (f11 = f31) And (f12 = f32) And (f13 <> f33) Then
' PerpLines.Value = "No solutions: First and Third Planes are Parallel"
' PerpLines.Visible = True
' Exit Sub
'End If
'Case 5: All Three planes overlap
'If (f11 = f21) And (f11 = f31) And (f12 = f22) And (f12 = f32) And (f13 = f23) And (f23 = f33) And (f13 = f33) Then
' PerpLines.Value = "Infinite # of solutions: All Three Planes Overlap"
' PerpLines.Visible = True
' Exit Sub
'End If
' There are still other cases, but for now let SolveSystemEq3 trap as general error
Call SolveSystemEq3
xanslabel.Visible = True
yanslabel.Visible = True
zanslabel.Visible = True
xansuf.Visible = True
yansuf.Visible = True
zansuf.Visible = True
End Sub
Private Sub CancelButton_Click()
MsgBox "I'm taking a poll on what most people want this button to do."
End Sub
Private Sub CommandButton1_Click()
Call togglefracdec(TextBox21)
Call togglefracdec(TextBox22)
Call togglefracdec(TextBox24)
Call togglefracdec(TextBox25)
End Sub

Private Sub togglefracdec(tb As TextBox)
Dim myVal$, myNum$, myDenom$
Dim myNumLen%, myCnt%
Dim myValResult As Variant

On Error GoTo myOther

myVal = tb.Value
myNumLen = Application.WorksheetFunction.Search("/", myVal)
myNum = Left(myVal, myNumLen - 1)
myCnt = Len(myVal)
myDenom = Right(myVal, myCnt - myNumLen)
myValResult = myNum / myDenom

tb.Value = Application.WorksheetFunction.Text(myValResult, "#,##0.000")
GoTo myEnd

myOther:
myVal = tb.Value
tb.Value = Application.WorksheetFunction.Text(myVal, "# ??/??")

myEnd:
End Sub

 

[Joe Was]

You can make my code universal a few ways, to make the Toggle Button toggle between a Decmial and a Fraction in the Active TextBox.

Define a Varaible as Public to contain the Active TextBox's name. Then Use the Change Event for Each TextBox to record its name. Then use that name in the button code to work on that last changed TextBox.

Note: The Button code has been changed to include additional error traps. It now tests for blanks, spaces and non numeric data. So, it should now catch any input error. If an error is found An error message is shown, that TextBox is selected and the bad value removed so you can edit it.


Public myCtrlTB$


Private Sub TextBox1_Change()
'UserForm module code, only!

myCtrlTB = "TextBox1"
End Sub

Private Sub TextBox2_Change()
'UserForm module code, only!

myCtrlTB = "TextBox2"
End Sub


Private Sub CommandButton1_Click()
'UserForm module code, only!
Dim myVal$, myNum$, myDenom$
Dim myNumLen%, myCnt%
Dim myValResult As Variant

Dim myTB As Control

On Error GoTo myOther

Set myTB = Controls.Item(myCtrlTB)

myVal = myTB.Value
myNumLen = Application.WorksheetFunction.Search("/", myVal)
myNum = Left(myVal, myNumLen - 1)
myCnt = Len(myVal)
myDenom = Right(myVal, myCnt - myNumLen)
myValResult = myNum / myDenom

myTB.Value = Application.WorksheetFunction.Text(myValResult, "#,##0.000")
GoTo myEnd

myOther:
On Error GoTo myErr

myVal = myTB.Value
If (myVal = "" Or myVal = " ") Then
GoTo myErr
ElseIf IsNumeric(myVal) = False Then
GoTo myErr
End If

myTB.Value = Application.WorksheetFunction.Text(myVal, "# ??/??")
GoTo myEnd

myErr:
MsgBox "Please Enter a number or fraction!", vbCritical + vbOKOnly, "Error with number!"
myTB.SetFocus
myTB.Value = ""

myEnd:
End Sub


Now if you change the TextBox Change Events to the "Enter" Event, then which ever TextBox has the Cursor in it when you Click the Toggle Button, will Be Toggled in format!

You can use both Events if you want. This will expand the editing ease for non-numeric data else it does little, due to the Enter Event taking president over the Change Event. You can use other Events As Well. Here is the Enter Event code sample:


Private Sub TextBox1_Enter()
'UserForm module code, only!

myCtrlTB = "TextBox1"
End Sub


Private Sub TextBox2_Enter()
'UserForm module code, only!

myCtrlTB = "TextBox2"

End Sub