Allow one digit or number in textboxes

[YasserKhalil]

Hello everyone
I need a way that enables me to allow only the user t input one number (digit) in the textbox
I have about 10 textboxes and need to apply that restriction on all these textboxes .. Numbers only allowed and only one digit

Thanks advanced for help

[mdmackillop]

If TextBox1 Like "*#*#*" Then MsgBox "only one digit permitted"

EDIT:
I missed the last line

If Not TextBox1 Like "#" Then MsgBox "only one digit permitted"

[YasserKhalil]

Thanks a lot for great help
I need to apply the rule to all the textboxes and no need for alert message .. When a digit is entered, there would be no way to input more ..
I am searching for an easier way to apply that restriction to all the textboxes all together .. instead of dealing with each textbox a lone .. What's the proper event for that?

[mdmackillop]

Are the boxes on a userform or worksheet?

[YasserKhalil]

The textboxes are on the userform. Sorry for not telling that in the first post

[shrivallabha]

Something like below for one textbox:

Private Sub TextBox1_Change()
If Not IsNumeric(Me.TextBox1.Value) Then
    Me.TextBox1.Value = ""
    Me.TextBox1.SetFocus
Else
    Me.TextBox1.Value = Left(Me.TextBox1.Value, 1)
    Me.TextBox2.SetFocus
End If
End Sub

[mdmackillop]

Different approach, assuming you want to loop through textboxes

Private Sub TextBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Call Test(TextBox1, 1)
End Sub


Private Sub TextBox2_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Call Test(TextBox2, 2)
End Sub


Sub Test(Val, TB)
    On Error Resume Next
    x = CInt(Val)
    If Err <> 0 Then
        With Me.Controls("Textbox" & TB)
            .Text = ""
            .SetFocus
            Exit Sub
        End With
    End If
    If x >= 0 And x < 9 Then
        If TB = 10 Then
            Me.CommandButton1.SetFocus  'or whatever
            Exit Sub
        Else
            Me.Controls("Textbox" & TB + 1).SetFocus
        End If
    End If
End Sub

[Paul_Hossler]

This allows only 0 or 1 digit in a textbox. Erases the input when there's a second digit


In a class module named clsTextBox

Option Explicit

Public WithEvents enhTextBox  As MSForms.TextBox
Private Sub enhTextBox_Change()
    Dim i As Long, n As Long
    
    
    For i = 1 To Len(enhTextBox.Text)
        Select Case Mid(enhTextBox.Text, i, 1)
            Case "0" To "9"
                n = n + 1
        End Select
    Next i
        
    If n > 1 Then
        Application.EnableEvents = False
        enhTextBox.Text = vbNullString
        Application.EnableEvents = True
    End If
End Sub

Userform1 code

Option Explicit
Dim aTextBoxes() As clsTextBox

Private Sub UserForm_Initialize()
    Dim oControl As Control
    Dim cnt As Long
    
    cnt = 0
    For Each oControl In Me.Controls
        If TypeName(oControl) = "TextBox" Then
            cnt = cnt + 1
            ReDim Preserve aTextBoxes(0 To cnt - 1)
            Set aTextBoxes(cnt - 1) = New clsTextBox
            Set aTextBoxes(cnt - 1).enhTextBox = oControl
        End If
    Next
    

End Sub
Private Sub UserForm_Terminate()
    Erase aTextBoxes
End Sub

[YasserKhalil]

Thanks a lot for all of you for these great solutions
@Mr. Paul
It is working fine but it allows characters .. and I need just a digit to be allowed nothing else ...

[Paul_Hossler]

Try this

Public WithEvents enhTextBox  As MSForms.TextBox 

Private Sub enhTextBox_Change() 
    Dim i As Long, n As Long 

     if Not enhTextBox.Text Like "#" Then
        Application.EnableEvents = False 
        enhTextBox.Text = vbNullString 
        Application.EnableEvents = True 
    End If 
End Sub

[YasserKhalil]

That's wonderful
Just last one point: How can automatically navigate from textbox to the other without using Tab? (Like the way Mr.mdmackillop provided?

[Paul_Hossler]

Tab order can be a little tricky since

1. the order can be rearranged by the developer:


Capture.JPG



2. You can't rely on the .Name of the control

3. Other types of controls can receive the Focus in the TabOrder

Try the attachment


Standard module

Option Explicit
Public aTextBoxes() As clsTextBox
Public aTabOrders() As Long

Sub drv()
    
    Load UserForm1
    UserForm1.Show
End Sub

Class module

Option Explicit
Public WithEvents enhTextBox  As MSForms.TextBox
Private Sub enhTextBox_Change()
    Dim i As Long
        
        
    If Not enhTextBox.Text Like "#" Then
        Application.EnableEvents = False
        enhTextBox.Text = vbNullString
        Application.EnableEvents = True
    
    Else
        For i = LBound(aTabOrders, 1) To UBound(aTabOrders, 1)
            If aTabOrders(i, 0) = enhTextBox.TabIndex Then
                If i = UBound(aTabOrders, 1) Then
                    aTextBoxes(LBound(aTabOrders, 2)).enhTextBox.SetFocus
                Else
                    aTextBoxes(aTabOrders(i + 1, 1)).enhTextBox.SetFocus
                End If
                Exit For
            End If
        Next I
    End If
End Sub

Userform

Option Explicit

Private Sub UserForm_Initialize()
    Dim oControl As Control
    Dim cnt As Long, i As Long, j As Long, x As Long
    
    cnt = 0
    For Each oControl In Me.Controls
        If TypeName(oControl) = "TextBox" Then
            cnt = cnt + 1
            ReDim Preserve aTextBoxes(0 To cnt - 1)
            Set aTextBoxes(cnt - 1) = New clsTextBox
            Set aTextBoxes(cnt - 1).enhTextBox = oControl
        End If
    Next
    
    'row = number aTextBoxes, col = tab order and aTexbox index
    ReDim aTabOrders(LBound(aTextBoxes) To UBound(aTextBoxes), 0 To 1)
    For cnt = LBound(aTextBoxes) To UBound(aTextBoxes)
        aTabOrders(cnt, 0) = aTextBoxes(cnt).enhTextBox.TabIndex
        aTabOrders(cnt, 1) = cnt
    Next cnt
    For i = LBound(aTabOrders, 1) To UBound(aTabOrders, 1) - 1
        For j = i To UBound(aTabOrders, 1)
            If aTabOrders(i, 0) > aTabOrders(j, 0) Then
                x = aTabOrders(i, 0)
                aTabOrders(i, 0) = aTabOrders(j, 0)
                aTabOrders(j, 0) = x
                x = aTabOrders(i, 1)
                aTabOrders(i, 1) = aTabOrders(j, 1)
                aTabOrders(j, 1) = x
            End If
        Next j
    Next i
End Sub
Private Sub UserForm_Terminate()
    Erase aTextBoxes
End Sub

[YasserKhalil]

That's really amazing and awesome Mr. Paul Hossler
Thank you very much for your great efforts
Best regards for all of you