Nadine Ruttimann
Nadine Ruttimann

Reputation: 61

Making VBA Form specific TextBox accept Numbers only and also "."

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

Answers (2)

Mathieu Guindon
Mathieu Guindon

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

jDave1984
jDave1984

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

Related Questions