Text Box for Numeric Data

[Chrissy]

Does anyone have some standard code they use to turn
a text box into a numeric data entry box?

If not, how do you handle data validation for entries you
want to restrict to numeric values?

Chrissy.

 

[Thomas]

Thats opening a can of beans,read here for possible solutions
http://makeashorterlink.com/?R20A52166

 

[Chrissy]

But it is a so bloody obvious requirement for many uses I think
it should be in VBA anyway.

What would be nice would be to add one property called Format
that is the same as the cell format in Excel and to use the Value
property to hold the Value and not just be a duplication of the
Text property. Text would be "as it is displayed" and Value would
be "as it is stored" so you could use Value in computations even when
it is displayed with other stuff like commas etc.

Chrissy.


Thomas wrote

 

[Chrissy]

Ok - now I have read that and YUCK.

Maybe it is time I bit the bullet and made my own NumbBox class
and used that - it would, of course, include a Format property and
another property to store the data. All other things about it would
probable be just a TextBox.

Chrissy.

 

[Thomas]

Sometimes its best to "roll your own".

Ok - now I have read that and YUCK.

Maybe it is time I bit the bullet and made my own NumbBox class
and used that - it would, of course, include a Format property and
another property to store the data. All other things about it would
probable be just a TextBox.

Chrissy.

 

[Chrissy]

All that is easy and the way I have done it. What I was actually
asking is that if someone has already come up with a more
efficient way then I would be interested cos I am lazy and
do not want to add 100+ Subs to my code just to check for
numbers.

Chrissy.

 

[Tom Ogilvy]

Harald Staff often recommends the keypress event and I endorse that. Here
is recent code Harald posted:

Private Sub TxtBox_KeyPress(ByVal keyascii As MSForms.ReturnInteger)
Select Case keyascii
Case 8 To 10, 13, 27, 44 'Control characters
Case 48 To 57 'numbers
Case Else 'Discard anything else
keyascii = 0
End Select
End Sub

 

[Thomas]

Not if the data is pasted into the textbox though.

 

[pfsardella]

Here are a couple of places to start.

http://www.google.com/groups?hl=en&lr=lang_en&ie=UTF-8&oe=UTF-8&safe=off&th=b978555a9db96311&rnum=5
http://support.microsoft.com/defaul...port/kb/articles/q158/7/49.asp&NoWebContent=1

HTH
Paul

 

[Harald Staff]

No, correct, this code snippet is the small heart of a quite big class. Ctrl V is caught
in then KeyDown event; cancelled, clipboard content validated and inserted. Question is,
what to do with it if the clipboard contain more than numbers ? It's also a question
whether to allow decimal separators or not, if so restrict it to one only. Decimal
separators are also depending on regional settings so you can't hardcode the ascii for it.
And what if clipboard content contains another decimal separator when you paste next to
the existing, where does its decimals go ?

Other events are KeyUp for possible "live" calculation, Enter for "select all text",
optional backcolor change and left aligned text (if the box supports it), and finally Exit
for number formatting and optional right aligned text.

 

[Chrissy]

Any chance of sending me the class?

Chrissy.

Harald Staff wrote

 

[Harald Staff]

Any chance of sending me the class?

Chrissy.

I'll post the general interest parts of it. Note that this is a VB6 class.
Forms2 textboxes and classes don't support all the events and properties, so
it takes some adjustments to squeeze itno a userform. Troublesome areas are
Clipboard content, GotFocus, LostFocus and textbox alignment. I know you're
good at this, Chrissy, so you take it from here:

Option Explicit

Public WithEvents TextBox As TextBox
Public tbValue As Double
Public LDecimals As Long
Public DecSep As String

Private Sub Class_Initialize()
Me.DecSep = Mid$(Format(1.5, "0.0"), 2, 1)
End Sub

Private Sub TextBox_GotFocus()
With TextBox
.Alignment = 0
.SelStart = 0
.SelLength = Len(.Text)
.BackColor = RGB(255, 255, 170)
End With
End Sub

Private Sub TextBox_KeyDown(KeyCode As Integer, Shift As Integer)
Dim Btmp As Boolean
If KeyCode = 86 And Shift = 2 Then
KeyCode = 0
TextBox.SelText = ""
Btmp = CBool(Me.LDecimals)
If InStr(TextBox.Text, DecSep) > 0 Then Btmp = False
Debug.Print TextBox.Text, InStr(TextBox.Text, DecSep)
TextBox.SelText = PastedText(Btmp)
End If
End Sub

Private Function PastedText(ByVal AllowDecSep As Boolean) As String
Dim Stmp As String
Dim D As Double
Dim L As Long
Stmp = Trim$(Clipboard.GetText)
Debug.Print AllowDecSep, Stmp
For L = 1 To Len(Stmp)
Select Case Asc(Mid$(Stmp, L))
Case 44, 46
If AllowDecSep Then
PastedText = PastedText & DecSep
AllowDecSep = False
End If
Case 48 To 57 'numbers
PastedText = PastedText & Mid$(Stmp, L, 1)
Case Else
End Select
Next

On Error Resume Next
D = CDbl(PastedText)
If D <> 0 Then
PastedText = CStr(D)
Else
PastedText = ""
End If
Debug.Print PastedText
Debug.Print
End Function

Private Sub TextBox_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case 8 To 10, 13, 27 'Control characters
Case 44, 46
If Me.LDecimals > 0 And InStr(TextBox.Text, DecSep) = 0 Then
KeyAscii = Asc(DecSep)
Else
Beep
KeyAscii = 0
End If
Case 48 To 57 'numbers
Case Else 'Discard anything else
Beep
KeyAscii = 0
End Select
End Sub

Private Sub TextBox_KeyUp(KeyCode As Integer, Shift As Integer)
If CDbl(Me.TextBox.Text) = 0 Then
Me.tbValue = 0
Else
Me.tbValue = CDbl(Replace$(TextBox.Text, " ", ""))
End If
'Call external calculations here
End Sub

Private Sub TextBox_LostFocus()
TextBox.Alignment = 1
TextBox.BackColor = vbWhite
If Trim$(TextBox.Text) = "" Then
Me.tbValue = 0
Else
Me.tbValue = CDbl(Replace$(TextBox.Text, " ", ""))
End If
TextBox.Text = Decorated(Me.tbValue, Me.LDecimals)
End Sub

Public Sub EnsureEntry()
Call TextBox_LostFocus
End Sub

Public Sub EmptyMe()
Me.TextBox.Text = ""
Call TextBox_LostFocus
End Sub

Private Function Decorated(DNumber As Double, Optional LDecimals As Long) As
String
Dim sDes As String
If LDecimals > 0 Then
sDes = "." & String(LDecimals, "0")
Else
sDes = ""
End If
Decorated = Format(DNumber, "# ### ### ##0" & sDes)
Decorated = Trim$(Decorated)
End Function

 

[Chrissy]

Harald Staff wrote

I'll post the general interest parts of it. Note that this is a VB6 class.
Forms2 textboxes and classes don't support all the events and properties, so
it takes some adjustments to squeeze itno a userform. Troublesome areas are
Clipboard content, GotFocus, LostFocus and textbox alignment. I know you're
good at this, Chrissy, so you take it from here:

You obviously over estimate me cos I have tired to use what you posted and
I am totally lost now.

I pasted that to a class module - was that what I was meant to do?
How do I now use it?

I am obviously missing something (like important info or a brain)

Chrissy.

 

[Harald Staff]

You obviously over estimate me cos I have tired to use what you posted and
I am totally lost now.

Ok <g>. I also edited this too hard. A few missing error handlers and no
support for negative numbers. Sorry.

Ok, from the top:
New Excel file.
Add a Userform1 containing Textbox1 and Textbox2.
Add a class module (Insert menu). Name the class "NumTxt" in the properties
window.
Paste this into the class module:

'**************************
Option Explicit

Public WithEvents TextBox As MSForms.TextBox
Public tbValue As Double
Public LDecimals As Long
Public Negatives As Boolean
Public DecSep As String

Private Sub Class_Initialize()
Me.DecSep = Mid$(Format(1.5, "0.0"), 2, 1)
Me.Negatives = True
End Sub

Public Sub EnterMe()
With TextBox
.SelStart = 0
.SelLength = Len(.Text)
.BackColor = RGB(255, 255, 170)
End With
End Sub

Private Sub TextBox_KeyDown(ByVal KeyCode As _
MSForms.ReturnInteger, ByVal Shift As Integer)
Dim Btmp As Boolean
If KeyCode = 86 And Shift = 2 Then
KeyCode = 0
TextBox.SelText = ""
Btmp = CBool(Me.LDecimals)
If InStr(TextBox.Text, DecSep) > 0 Then Btmp = False
Debug.Print TextBox.Text, InStr(TextBox.Text, DecSep)
TextBox.SelText = PastedText(Btmp)
End If
End Sub

Private Function PastedText(ByVal AllowDecSep As Boolean) As String
Dim MyDataObj As New DataObject
Dim Stmp As String
Dim D As Double
Dim L As Long

MyDataObj.GetFromClipboard
Stmp = Trim$(MyDataObj.GetText)
Debug.Print AllowDecSep, Stmp
For L = 1 To Len(Stmp)
Select Case Asc(Mid$(Stmp, L))
Case 44, 46
If AllowDecSep Then
PastedText = PastedText & DecSep
AllowDecSep = False
End If
Case 45
If Me.Negatives And TextBox.SelStart = 0 And _
(Len(PastedText) = 0) Then _
PastedText = "-"
Case 48 To 57 'numbers
PastedText = PastedText & Mid$(Stmp, L, 1)
Case Else
End Select
Next

On Error Resume Next
D = CDbl(PastedText)
If D <> 0 Then
PastedText = CStr(D)
Else
PastedText = ""
End If
Debug.Print PastedText
Debug.Print
End Function

Private Sub TextBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 8 To 10, 13, 27 'Control characters
Case 44, 46
If Me.LDecimals > 0 And InStr(TextBox.Text, DecSep) = 0 Then
KeyAscii = Asc(DecSep)
Else
Beep
KeyAscii = 0
End If
Case 45
If Me.Negatives And TextBox.SelStart = 0 Then
Else
Beep
KeyAscii = 0
End If
Case 48 To 57 'numbers
Case Else 'Discard anything else
Beep
KeyAscii = 0
End Select
End Sub

Private Sub TextBox_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal
Shift As Integer)
On Error Resume Next
If IsError(CDbl(Me.TextBox.Text)) Then
Me.tbValue = 0
ElseIf CDbl(Me.TextBox.Text) = 0 Then
Me.tbValue = 0
Else
Me.tbValue = CDbl(Replace$(TextBox.Text, " ", ""))
End If
Call UserForm1.CalculateMe
End Sub

Public Sub ExitMe()
TextBox.BackColor = vbWhite
On Error Resume Next
If IsError(CDbl(Me.TextBox.Text)) Then
Me.tbValue = 0
'ElseIf Trim$(TextBox.Text) = "" Then
' Me.tbValue = 0
Else
Me.tbValue = CDbl(Replace$(TextBox.Text, " ", ""))
End If
TextBox.Text = Decorated(Me.tbValue, Me.LDecimals)
End Sub

Public Sub EmptyMe()
Me.TextBox.Text = ""
Call ExitMe
End Sub

Private Function Decorated(DNumber As Double, Optional LDecimals As Long) As
String
Dim sDes As String
If LDecimals > 0 Then
sDes = "." & String(LDecimals, "0")
Else
sDes = ""
End If
Decorated = Format(DNumber, "# ### ### ##0" & sDes)
Decorated = Trim$(Decorated)
End Function

'**************************************

Now back to the userform. Paste this into its module:

'**************************************
Option Explicit

Dim Num1 As New NumTxt
Dim Num2 As New NumTxt

Private Sub UserForm_Initialize()
Set Num1.TextBox = Me.TextBox1
Num1.LDecimals = 2 'decimals allowed, display two
Set Num2.TextBox = Me.TextBox2
Num2.Negatives = False 'no negative numbers, no decimals
End Sub

Private Sub TextBox1_Enter()
Call Num1.EnterMe
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call Num1.ExitMe
End Sub

Private Sub TextBox2_Enter()
Call Num2.EnterMe
End Sub

Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call Num2.ExitMe
End Sub

Public Sub CalculateMe()
Me.Caption = "Product: " & Num1.tbValue * Num2.tbValue
End Sub

'**************************************

Now run it. Enter stuff, paste stuff with Ctrl V, watch things happen when
you type and when you tab between the boxes.

 

[Chrissy]

Now that I can follow - I think old age is getting to me.
I will do it tomorrow cos I need sleep now.

Thanks.

Chrissy.

Harald Staff wrote