Reputation: 61
I want to block some specific textboxes has numeric values only and accept ".". However, it blocks almost all my textboxes in my userform. I don't understand why. What I forgot in my code?
Private Sub tbxHour_Exit(ByVal Cancel As MSForms.ReturnBoolean)
'Making TextBox accept Numbers only
If Not IsNumeric(tbxHour.Value) Then
MsgBox "only numbers allowed"
Cancel = True
End If
End Sub
Private Sub tbxHour_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
Case 46
If InStr(1, tbxHour, ".") > 0 Then KeyAscii = 0
Case 48 To 57
Case Else
KeyAscii = 0
End Select
End Sub
Upvotes: 2
Views: 11973
Reputation: 71167
I use this simply NumKeyValidator
class for that, to simply prevent invalid input to be supplied by the user:
Option Explicit
Private Const vbKeyDot As Integer = 46
Public Function IsValidKeyAscii(ByVal keyAscii As Integer, ByVal value As String) As Boolean
'returns true if specified keyAscii is a number, or if it's a dot and value doesn't already contain one
IsValidKeyAscii = (keyAscii = vbKeyDot And InStr(1, value, Chr$(vbKeyDot)) = 0) Or (keyAscii >= vbKey0 And keyAscii <= vbKey9)
End Function
You can use it by simply declaring an instance field for it:
Private validator As New NumKeyValidator
And then you use it in each textbox' KeyPress
handler, like this:
Private Sub tbxHour_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If Not validator.IsValidKeyAscii(keyAscii, tbxHour.Value) Then keyAscii = 0
End Sub
There's no need to handle Exit
and pop a MsgBox
then - either the box is empty, or it contains a valid number; you could have an IsValidForm
property that returns True
if all required textboxes contain numbers, and false otherwise - and then decide that the form's Ok button is disabled until the form is valid.
FWIW that validator class is quite thoroughly tested (using Rubberduck unit tests [disclaimer: I own that open-source VBE add-in project]):
Option Explicit
Option Private Module
'@TestModule
'' uncomment for late-binding:
Private Assert As Object
'' early-binding requires reference to Rubberduck.UnitTesting.tlb:
'Private Assert As New Rubberduck.AssertClass
'@TestMethod
Public Sub DotIsValidForEmptyValue()
On Error GoTo TestFail
'Arrange:
Dim actual As Boolean
Dim sut As New NumKeyValidator
'Act:
actual = sut.IsValidKeyAscii(Asc("."), vbNullString)
'Assert:
Assert.IsTrue actual
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
'@TestMethod
Public Sub DotIsValidForNonEmptyValueWithoutAnyDots()
On Error GoTo TestFail
'Arrange:
Dim actual As Boolean
Dim sut As New NumKeyValidator
'Act:
actual = sut.IsValidKeyAscii(Asc("."), "123")
'Assert:
Assert.IsTrue actual
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
'@TestMethod
Public Sub DotIsInvalidWhenValueHasDot()
On Error GoTo TestFail
'Arrange:
Dim actual As Boolean
Dim sut As New NumKeyValidator
'Act:
actual = sut.IsValidKeyAscii(Asc("."), "123.45")
'Assert:
Assert.IsFalse actual
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
'@TestMethod
Public Sub AllDigitsAreValid()
On Error GoTo TestFail
Dim sut As New NumKeyValidator
Assert.IsTrue sut.IsValidKeyAscii(Asc("0"), vbNullString)
Assert.IsTrue sut.IsValidKeyAscii(Asc("1"), vbNullString)
Assert.IsTrue sut.IsValidKeyAscii(Asc("2"), vbNullString)
Assert.IsTrue sut.IsValidKeyAscii(Asc("3"), vbNullString)
Assert.IsTrue sut.IsValidKeyAscii(Asc("4"), vbNullString)
Assert.IsTrue sut.IsValidKeyAscii(Asc("5"), vbNullString)
Assert.IsTrue sut.IsValidKeyAscii(Asc("6"), vbNullString)
Assert.IsTrue sut.IsValidKeyAscii(Asc("7"), vbNullString)
Assert.IsTrue sut.IsValidKeyAscii(Asc("8"), vbNullString)
Assert.IsTrue sut.IsValidKeyAscii(Asc("9"), vbNullString)
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
'@TestMethod
Public Sub AlphaIsInvalid()
On Error GoTo TestFail
'Arrange:
Dim actual As Boolean
Dim sut As New NumKeyValidator
'Act:
actual = sut.IsValidKeyAscii(Asc("a"), vbNullString)
'Assert:
Assert.IsFalse actual
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
'@TestMethod
Public Sub DollarSignIsInvalid()
On Error GoTo TestFail
'Arrange:
Dim actual As Boolean
Dim sut As New NumKeyValidator
'Act:
actual = sut.IsValidKeyAscii(Asc("$"), vbNullString)
'Assert:
Assert.IsFalse actual
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
'@TestMethod
Public Sub NegativeSignIsInvalid()
On Error GoTo TestFail
'Arrange:
Dim actual As Boolean
Dim sut As New NumKeyValidator
'Act:
actual = sut.IsValidKeyAscii(Asc("-"), vbNullString)
'Assert:
Assert.IsFalse actual
TestExit:
Exit Sub
TestFail:
Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
That said I don't see how the code you've shown could ever "block almost all textboxes in your userform".
Upvotes: 0
Reputation: 962
This one worked for me:
Private Sub tbxHour_AfterUpdate()
'Make sure the item is Numeric or has a "." in it
If Not IsNumeric(Me.tbxHour.Text) And Not Me.tbxHour.Text = "." Then
MsgBox "This is illegal!"
Me.tbxHour.Text = ""
End If
End Sub
Short. Simple. Effective and looks like what you're trying to do anyway.
Upvotes: 2