TextBox format validation...

albertc30

Well-known Member
Joined
May 7, 2012
Messages
1,091
Office Version
  1. 2019
Platform
  1. Windows
Hi all.

Firstly, as always, a much big thank you for all the help provided in the past and currently. This is much appreciated.

Secondly, another issue. This issue being I have a textbox for customer phone. I need to format this to


  1. only allow 11 digits, no more, no less,
  2. it can't use nothing else other than numbers,
  3. to be displayed in the box as 00000 000 000.

Now, some of my existing code already does part of this, and I did had it formatting to 00000 000 000 but this was by way of beforevalidate.

I have since then added code to change function and now it's all messed up.

Code:
Private Sub tbnctel_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)


'
 '   Application.EnableEvents = False
  '  If Len(tbnctel.Value) < 11 Then
   '     Cancel = True
    '    MsgBox "Error! Contact number not long enough.", vbCritical
     '   tbnctel.Value = Left(Me.tbnctel.Value, 11) '<--Not sure why this is even here!
      '  tbnctel.Value = ""
       ' tbnctel.SetFocus
'    Else
 '       tbnctel = Format(tbnctel, "00000 000 000") 'This worked fine without the Change code bellow...
  '  End If
   ' Application.EnableEvents = True






End Sub




Private Sub tbnctel_Change()
    Dim i, text_count As Integer
        If Len(Me.tbnctel.Value) > 0 Then
            text_count = 0
            For i = 1 To Len(Me.tbnctel.Value)
                If IsNumeric(Mid(Me.tbnctel.Value, i, 1)) = False Then
                    Me.tbnctel.Value = Replace(Me.tbnctel.Value, Mid(Me.tbnctel.Value, i, 1), "")
                    text_count = text_count + 1
                End If
            Next i
                If text_count > 0 Then
                    MsgBox "Only numbers are allowed!"
        
    Exit Sub
             
                End If
            End If
            tbnctel = Format(tbnctel, "00000 000 000") 'might work here?
End Sub

Any help much appreciated.

Thank you all for your time.

Cheers.
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.
hi.

Forgot to say, number needs to start 01 or 02 or 03.

Thanks.
 
Upvote 0
The problem with incorperating the Change event is that while entering a vaild string into an empty textbox, there must be some invalid entries in the box.

You could try this
1) set the default value of the box to 00000 000 000
2) set the .AutoWordSelect property to False

and use code like this. What the code does is modify the null string (pressing the delete key changes the selected text to 0 rather than removing the characters)

Code:
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim curText As String, cStart As Long, cLength As Long
    
    Select Case KeyCode
        Case vbKeyTab, vbKeyReturn
        
        Case vbKeyBack
            With TextBox1
                curText = .Text
                cStart = .SelStart
                cLength = .SelLength
                
                If .SelLength = 0 Then
                    cStart = cStart - 1
                    Mid(curText, cStart + 1, 1) = Mid("00000 000 000", cStart + 1, cLength)
                Else
                    Mid(curText, cStart + 1, cLength) = Mid("00000 000 000", cStart + 1, cLength)
                End If
                .Text = curText
                .SelStart = cStart
                .SelLength = 1
                KeyCode = 0
            End With
        Case Else
        
    End Select
End Sub

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim curText As String, newChr As String
    Dim cStart As Long, cLength As Long
    newChr = Chr(KeyAscii)
    KeyAscii = 0
    If newChr Like "[0-9]" And TextBox1.SelStart < Len(TextBox1.Text) Then
        With TextBox1
            curText = .Text
            cStart = .SelStart
            cLength = .SelLength
            Mid(curText, .SelStart + 1, 1) = newChr
            Mid(curText, 1, 1) = "0"
            
            .Text = curText
            If Mid(.Text, cStart + 2, 1) = " " Then cStart = cStart + 1
            .SelStart = cStart + 1
            .SelLength = 1
        End With
    Else
        Beep
    End If
End Sub

Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    With TextBox1
        If .SelLength = 0 Then .SelLength = 1
    End With
End Sub
 
Last edited:
Upvote 0
This is an upgrade.
Note that the default value for the textbox should now be 01000 000 000

Code:
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim curText As String, cStart As Long, cLength As Long
    Const strZero As String = "01000 000 000"
    
    Select Case KeyCode
        Case vbKeyTab, vbKeyReturn
        
        Case vbKeyBack
            With TextBox1
                curText = .Text
                cStart = .SelStart
                cLength = .SelLength
                
                If .SelLength = 0 Then
                    cStart = cStart - 1
                    Mid(curText, cStart + 1, 1) = Mid(strZero, cStart + 1, cLength)
                Else
                    Mid(curText, cStart + 1, cLength) = Mid(strZero, cStart + 1, cLength)
                End If
                .Text = curText
                .SelStart = cStart
                .SelLength = 1
                KeyCode = 0
            End With
        Case Else
        
    End Select
End Sub

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim curText As String, newChr As String
    Dim cStart As Long, cLength As Long
    newChr = Chr(KeyAscii)
    KeyAscii = 0
    With TextBox1
        curText = .Text
        cStart = .SelStart
        cLength = .SelLength
        
        If .SelStart < Len(.Text) Then
            Mid(curText, .SelStart + 1, 1) = newChr
        Else
            curText = "no good"
        End If
        
        If curText Like "0[123]### ### ###" Then
            .Text = curText
            If Mid(.Text, cStart + 2, 1) = " " Then cStart = cStart + 1
            .SelStart = cStart + 1
            .SelLength = 1
        Else
            Beep
        End If
    End With
End Sub

Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    With TextBox1
        If .SelLength = 0 Then .SelLength = 1
    End With
End Sub
 
Last edited:
Upvote 0
Hi.

Sorry for the long delay but being Sunday I had to take a break from the screen.

I have tried your code but now it won't let me type any value on the texbox.

Perhaps I have done something wrong.

Many thanks for helping and for the time given to us.

Much appreciated.

Cheers.
 
Upvote 0
Are you saying that you can't type anything at all, it should allow you to enter numbers and have them in the desired format.
 
Upvote 0
Yes mate.

It won't allow me to type in anything.
 
Upvote 0
Create a new userform with one textbox.
Put this code in the code module. Does it work as you desire?
(the code is from post #4 , with an initialize event to set the desired default properties of the textbox.)
Code:
Private Sub UserForm_Initialize()
    TextBox1.Text = "01000 000 000"
    TextBox1.AutoWordSelect = False

    TextBox1.SelStart = 0
    TextBox1.SelLength = 1
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim curText As String, cStart As Long, cLength As Long
    Const strZero As String = "01000 000 000"
    
    Select Case KeyCode
        Case vbKeyTab, vbKeyReturn
        
        Case vbKeyBack
            With TextBox1
                curText = .Text
                cStart = .SelStart
                cLength = .SelLength
                
                If .SelLength = 0 Then
                    cStart = cStart - 1
                    Mid(curText, cStart + 1, 1) = Mid(strZero, cStart + 1, 1)
                Else
                    Mid(curText, cStart + 1, cLength) = Mid(strZero, cStart + 1, cLength)
                End If
                .Text = curText
                .SelStart = cStart
                .SelLength = 1
                KeyCode = 0
            End With
        Case Else
        
    End Select
End Sub

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim curText As String, newChr As String
    Dim cStart As Long, cLength As Long
    newChr = Chr(KeyAscii)
    KeyAscii = 0
    With TextBox1
        curText = .Text
        cStart = .SelStart
        cLength = .SelLength
        
        If .SelStart < Len(.Text) Then
            Mid(curText, .SelStart + 1, 1) = newChr
        Else
            curText = "no good"
        End If
        
        If curText Like "0[123]### ### ###" Then
            .Text = curText
            If Mid(.Text, cStart + 2, 1) = " " Then cStart = cStart + 1
            .SelStart = cStart + 1
            .SelLength = 1
        Else
            Beep
        End If
    End With
End Sub

Private Sub TextBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
    With TextBox1
        If .SelLength = 0 Then .SelLength = 1
    End With
End Sub

Edit: I just noticed that at start up, the cursor is at the end of the string. The routine won't let you add a twelveth digit, hence the added .SelStart code in the Intialize event.

Additional note: with the first character selected, the only acceptable entry is "0" per post #2 .
 
Last edited:
Upvote 0
Here is a completely different approach then Mike's code. My code will only allow digits to be typed or pasted into the TextBox, you can only exit the TextBox if it contains 11 digits with the first two digits being 01, 02 or 03. You can also exit the TextBox when it is completely empty (press the Esc Key to clear the text at any time). For this code to work, you would need to remove all of your existing code in the UserForm code window and replace it with this (exactly as written... that first Dim statement must be located outside of any code procedure as shown). As with any major code suggestions posted in this forum, it would be prudent to work with a copy of your workbook until you are satisfied the suggested code in fact does exactly what you want.
Code:
[table="width: 500"]
[tr]
	[td]Dim LastPosition As Long

Private Sub tbnctel_Change()
  Static LastText As String
  Static SecondTime As Boolean
  If Not SecondTime Then
    With tbnctel
      If InStr(.Text, " ") Then Exit Sub
      If .Text Like "*[!0-9]*" Then
        Beep
        SecondTime = True
        .Text = LastText
        .SelStart = LastPosition
      Else
        LastText = .Text
      End If
    End With
  End If
  SecondTime = False
End Sub
 
Private Sub tbnctel_Enter()
  tbnctel.Text = Replace(tbnctel.Text, " ", "")
End Sub

Private Sub tbnctel_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  If (Len(tbnctel.Text) = 11 And tbnctel.Text Like "0[1-3]*") Or Len(tbnctel.Text) = 0 Then
    tbnctel.Text = Format(tbnctel.Text, "00000 000 000")
  Else
    MsgBox "Error! Contact number is not valid!", vbCritical
    Cancel = True
  End If
End Sub

Private Sub tbnctel_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
  If KeyCode = 27 Then
    tbnctel.Text = ""
  End If
End Sub

Private Sub tbnctel_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  LastPosition = tbnctel.SelStart
End Sub
 
Private Sub tbnctel_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
  LastPosition = tbnctel.SelStart
End Sub[/td]
[/tr]
[/table]
 
Last edited:
Upvote 0
Hello everyone.

Mike, Rick.

I'm off today til Thursday looking after my kids, so I was away from the screen.

So, as a result I didn't see your answers till Rick's was here already.

Tried Ricks and its working a treat.

I am now looking for ways to validate email on a textbox.

I'm sure I'll be posting something soon.

Much appreciated for all of your help lads, as always, it's great help and the time you guys spend giving your knowledge to the the rest of us, like me, not so savvy on coding, is absolutely incredible.

So, many thanks to you all.

Cheers
 
Upvote 0

Forum statistics

Threads
1,224,820
Messages
6,181,162
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top