Validate userform textbox entry -multiple criteria -vba

kelly mort

Well-known Member
I have this textbox that I want it to hold this kind of text format:

"12345678" or "ABC/1234/12"

Now these are the conditions I want to validate:

1. If I start with a number, then accept only numbers and stop registering any key stroke when the length of the textbox reaches 8 characters

2. If I start the entry with a letter, then:
- The first 3 characters must be letters only

- The fourth character must be a forward slash. If I forget to add it and press a number value as shown from my sample above, then I want to add that slash before I register the pressed key.

- After the first slash, the next 4 characters are to be numbers.
- Then we repeat the second rule under point(2) above.
- We also repeat third rule under point(2) above this time for the last two characters.

3. The entry should only start with a number or a letter. I don't want to register the spacebar when pressed.

4. I will want to be able to use the delete and backspace keys to make edit. In that case, the above rules still hold valid. So when I delete one letter from the ABC, I should add or fix that letter before any further registration of keys are implemented.

Thanks in advance for reading this. I will be very glad to have a solution to this. Seems a bit complex to me to process ATM.
 

AlphaFrog

MrExcel MVP
There's probably a more elegant Reg Edit way, but I don't know RedEd patterns well enough.

Try this.

Code:
[color=darkblue]Private[/color] [color=darkblue]Sub[/color] TextBox1_KeyPress([color=darkblue]ByVal[/color] KeyAscii As MSForms.ReturnInteger)
    [color=green]'"12345678" or "ABC/1234/12"[/color]
    [color=darkblue]With[/color] Me.TextBox1
        [color=darkblue]Select[/color] [color=darkblue]Case[/color] [color=darkblue]True[/color]
            [color=green]'numbers[/color]
            [color=darkblue]Case[/color] .Text & Chr(KeyAscii) [color=darkblue]Like[/color] Left("########", Len(.Text) + 1)
            [color=green]'text[/color]
            [color=darkblue]Case[/color] .Text & Chr(KeyAscii) [color=darkblue]Like[/color] "[A-Z]"
            [color=darkblue]Case[/color] .Text & Chr(KeyAscii) [color=darkblue]Like[/color] "[A-Z][A-Z]"
            [color=darkblue]Case[/color] .Text & Chr(KeyAscii) [color=darkblue]Like[/color] "[A-Z][A-Z][A-Z]" And KeyAscii <> 8
                .Text = .Text & Chr(KeyAscii) & "/"
                KeyAscii = 0
            [color=darkblue]Case[/color] .Text [color=darkblue]Like[/color] "[A-Z][A-Z][A-Z]" And Chr(KeyAscii) [color=darkblue]Like[/color] "#"
                .Text = .Text & "/"
            [color=darkblue]Case[/color] .Text & Chr(KeyAscii) [color=darkblue]Like[/color] "[A-Z][A-Z][A-Z]/"
            [color=darkblue]Case[/color] .Text & Chr(KeyAscii) [color=darkblue]Like[/color] "[A-Z][A-Z][A-Z]/#"
            [color=darkblue]Case[/color] .Text & Chr(KeyAscii) [color=darkblue]Like[/color] "[A-Z][A-Z][A-Z]/##"
            [color=darkblue]Case[/color] .Text & Chr(KeyAscii) [color=darkblue]Like[/color] "[A-Z][A-Z][A-Z]/###"
            [color=darkblue]Case[/color] .Text & Chr(KeyAscii) [color=darkblue]Like[/color] "[A-Z][A-Z][A-Z]/####" And KeyAscii <> 8
                .Text = .Text & Chr(KeyAscii) & "/"
                KeyAscii = 0
            [color=darkblue]Case[/color] .Text & Chr(KeyAscii) [color=darkblue]Like[/color] "[A-Z][A-Z][A-Z]/####/"
            [color=darkblue]Case[/color] .Text [color=darkblue]Like[/color] "[A-Z][A-Z][A-Z]/####" And Chr(KeyAscii) [color=darkblue]Like[/color] "#"
                .Text = .Text & "/"
            [color=darkblue]Case[/color] .Text & Chr(KeyAscii) [color=darkblue]Like[/color] "[A-Z][A-Z][A-Z]/####/#"
            [color=darkblue]Case[/color] .Text & Chr(KeyAscii) [color=darkblue]Like[/color] "[A-Z][A-Z][A-Z]/####/##"
            [color=darkblue]Case[/color] Else: KeyAscii = 0
        [color=darkblue]End[/color] [color=darkblue]Select[/color]
    [color=darkblue]End[/color] [color=darkblue]With[/color]
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 

kelly mort

Well-known Member
There's probably a more elegant Reg Edit way, but I don't know RedEd patterns well enough.

Try this.

Code:
[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] TextBox1_KeyPress([COLOR=darkblue]ByVal[/COLOR] KeyAscii As MSForms.ReturnInteger)
    [COLOR=green]'"12345678" or "ABC/1234/12"[/COLOR]
    [COLOR=darkblue]With[/COLOR] Me.TextBox1
        [COLOR=darkblue]Select[/COLOR] [COLOR=darkblue]Case[/COLOR] [COLOR=darkblue]True[/COLOR]
            [COLOR=green]'numbers[/COLOR]
            [COLOR=darkblue]Case[/COLOR] .Text & Chr(KeyAscii) [COLOR=darkblue]Like[/COLOR] Left("########", Len(.Text) + 1)
            [COLOR=green]'text[/COLOR]
            [COLOR=darkblue]Case[/COLOR] .Text & Chr(KeyAscii) [COLOR=darkblue]Like[/COLOR] "[A-Z]"
            [COLOR=darkblue]Case[/COLOR] .Text & Chr(KeyAscii) [COLOR=darkblue]Like[/COLOR] "[A-Z][A-Z]"
            [COLOR=darkblue]Case[/COLOR] .Text & Chr(KeyAscii) [COLOR=darkblue]Like[/COLOR] "[A-Z][A-Z][A-Z]" And KeyAscii <> 8
                .Text = .Text & Chr(KeyAscii) & "/"
                KeyAscii = 0
            [COLOR=darkblue]Case[/COLOR] .Text [COLOR=darkblue]Like[/COLOR] "[A-Z][A-Z][A-Z]" And Chr(KeyAscii) [COLOR=darkblue]Like[/COLOR] "#"
                .Text = .Text & "/"
            [COLOR=darkblue]Case[/COLOR] .Text & Chr(KeyAscii) [COLOR=darkblue]Like[/COLOR] "[A-Z][A-Z][A-Z]/"
            [COLOR=darkblue]Case[/COLOR] .Text & Chr(KeyAscii) [COLOR=darkblue]Like[/COLOR] "[A-Z][A-Z][A-Z]/#"
            [COLOR=darkblue]Case[/COLOR] .Text & Chr(KeyAscii) [COLOR=darkblue]Like[/COLOR] "[A-Z][A-Z][A-Z]/##"
            [COLOR=darkblue]Case[/COLOR] .Text & Chr(KeyAscii) [COLOR=darkblue]Like[/COLOR] "[A-Z][A-Z][A-Z]/###"
            [COLOR=darkblue]Case[/COLOR] .Text & Chr(KeyAscii) [COLOR=darkblue]Like[/COLOR] "[A-Z][A-Z][A-Z]/####" And KeyAscii <> 8
                .Text = .Text & Chr(KeyAscii) & "/"
                KeyAscii = 0
            [COLOR=darkblue]Case[/COLOR] .Text & Chr(KeyAscii) [COLOR=darkblue]Like[/COLOR] "[A-Z][A-Z][A-Z]/####/"
            [COLOR=darkblue]Case[/COLOR] .Text [COLOR=darkblue]Like[/COLOR] "[A-Z][A-Z][A-Z]/####" And Chr(KeyAscii) [COLOR=darkblue]Like[/COLOR] "#"
                .Text = .Text & "/"
            [COLOR=darkblue]Case[/COLOR] .Text & Chr(KeyAscii) [COLOR=darkblue]Like[/COLOR] "[A-Z][A-Z][A-Z]/####/#"
            [COLOR=darkblue]Case[/COLOR] .Text & Chr(KeyAscii) [COLOR=darkblue]Like[/COLOR] "[A-Z][A-Z][A-Z]/####/##"
            [COLOR=darkblue]Case[/COLOR] Else: KeyAscii = 0
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Select[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Wow. This is more than elegant!!!

It worked very well.


One issue:
When I want to do the edit, it does not register its keys.

That's when I enter

ABC/1234/12

Then delete the C to form

AB/1234/12

when I decide to add the C again, it does not register it. I have to clear everything to start again. If this can be done I will love it

But still, you are the man!!!:cool:
 

AlphaFrog

MrExcel MVP
This method only verifies the right most characters as they are entered. I don't know how to verify mid edits.
 

mikerickson

MrExcel MVP
I think this will do what you want. Note that if the user deletes a slash, it must be the first character restored.
Code:
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    Dim newString As String, isOK As Boolean
    Const strLetter As String = "[A-Z]"
    
    KeyAscii = Asc(UCase(Chr(KeyAscii)))
    With TextBox1
        newString = Left(.Text, .SelStart) & Chr(KeyAscii) & Mid(.Text, .SelStart + .SelLength + 1)
    End With
    
    If newString Like "#*" Then
        isOK = Chr(KeyAscii) Like "#" And Len(newString) <= 8
    ElseIf newString Like strLetter Or newString Like strLetter & strLetter Then
        isOK = True
    ElseIf newString Like strLetter & strLetter & strLetter Then
        TextBox1.Text = newString
        KeyAscii = Asc("/")
        isOK = True
    ElseIf newString Like strLetter & strLetter & strLetter & "/#" Then
        isOK = True
    ElseIf newString Like strLetter & strLetter & strLetter & "/##" Then
        isOK = True
    ElseIf newString Like strLetter & strLetter & strLetter & "/###" Then
        isOK = True
    ElseIf newString Like strLetter & strLetter & strLetter & "/####" Then
        TextBox1.Text = newString
        KeyAscii = Asc("/")
        isOK = True
    ElseIf newString Like strLetter & strLetter & strLetter & "/####/#" Then
        isOK = True
    ElseIf newString Like strLetter & strLetter & strLetter & "/####/##" Then
        isOK = True
    Else
        isOK = False
    End If
    
    If Not isOK Then
        KeyAscii = 0
        Beep
    End If
End Sub
 

Some videos you may like

This Week's Hot Topics

  • Get External Data (long shot question!)
    This is likely a long shot but I am wondering if it is at all possible for Excel to somehow 'change' the contents of a URL that is being linked to...
  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • Cell Formatting
    Good Morning, I need to format a few different cells in the following manners: A1 has to always add a colon (:) after whatever is typed in by a...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • Workbook_Change stopped working !
    I am working on an app to speed up & automate processing of Credit Cards statements. After data is input from a CSV file, it is presented to the...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...
Top