user2051986
user2051986

Reputation:

Restricting textbox entries in Excel UserForm

I'm building a UserForm in Excel VBA for simple data entry (i.e. surveys). The surveys are in the basic "Strongly Disagree" to "Strongly Agree" format. Each respondent has 8 options per question ("1"-"5" for the agreement rankings, "99" for N/A, and "88" should the respondent choose not to answer). To improve the speed and accuracy of the data entry process, I need my UserForm to only allow only those integers in the textboxes.

I've messed around with KeyPress, but have run into some trouble with the double digit entries. Here's what I had:

Private Sub textbox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
    Case Asc("1") To Asc ("5")
    Case Asc("88")
    Case Asc("99")
    Case Else
        KeyAscii = 0
End Select
End Sub

This worked alright, except that it's not perfect, in that it also allows invalid entries such as, "11" - "15", "81" - "85", and so forth. I've spent a good two weeks looking around the internet for something and haven't found anything. Surely there is a simple way to validate these textboxes the way I'm asking, but I just can't seem to figure it out. Any help would be greatly appreciated.

Just let me know if anyone needs more of the code. Thanks in advance for your help.

Upvotes: 1

Views: 13128

Answers (3)

DrMarbuse
DrMarbuse

Reputation: 870

My code as extension of Doug Glancys suggestion. The solution uses the tag-property of each of the textboxes.

''
' Validate all textboxes in the userform
'
Private Sub Validate()
    Dim cntrol As Control
    Dim msgText As String

    'loop through all the controls
    For Each cntrol In Me.Controls
        'check to see if it is a textbox
        If TypeOf cntrol Is MSForms.TextBox Then
            Dim tBox As MSForms.TextBox
            Set tBox = cntrol
            'we have a textbox so validate the entry
            If validateTextBox(tBox, msgText) Then
                ' did not validate so set focus on the control
                ' select control
                selectControl cntrol
                MsgBox msgText, vbCritical + vbOKOnly, "Invalid Data"
                'release the object
                Set tBox = Nothing
                'exit as we do not need to process further
                Exit Sub
            End If
            Set tBox = Nothing
        End If
    Next
End Sub

''
' validate a textbox's value and return true or false
'
' tb is a textbox control
' msgText is a return variable holding the message text
'
Private Function validateTextBox(tb As MSForms.TextBox, Optional ByRef msgText As Variant) As Boolean

    ' constants for tag-information
    Const TAG_VALIDATE_OPEN = "[validate:"
    Const TAG_VALIDATE_CLOSE = "]"
    Const TAG_VALIDATE_DATA_OPEN = "{"
    Const TAG_VALIDATE_DATA_CLOSE = "}"

    ' variables
    Dim sValue As String
    Dim isValid As Boolean
    Dim pos1 As Long
    Dim pos2 As Long
    Dim vSpec As String
    Dim VSpecData() As String
    Dim VSpecDataDefined As Boolean
    VSpecDataDefined = False

    isValid = False
    sValue = Trim(tb.text)

    '
    ' analyse tag-string and get specifications.
    ' Syntax for tag is [validate:command{data1,data2,data3}]
    '
    pos1 = InStr(1, LCase(tb.Tag), LCase(TAG_VALIDATE_OPEN))
    If pos1 > 0 Then
        pos2 = InStr(pos1 + Len(TAG_VALIDATE_OPEN), tb.Tag, TAG_VALIDATE_CLOSE)
        vSpec = Mid(tb.Tag, pos1 + Len(TAG_VALIDATE_OPEN), pos2 - (pos1 + Len(TAG_VALIDATE_OPEN)))

        pos1 = InStr(1, vSpec, TAG_VALIDATE_DATA_OPEN)
        If pos1 > 0 Then
            pos2 = InStr(pos1, vSpec, TAG_VALIDATE_DATA_CLOSE)
            VSpecDataDefined = True
            VSpecData = Split(Mid(vSpec, pos1 + Len(TAG_VALIDATE_DATA_OPEN), pos2 - (pos1 + Len(TAG_VALIDATE_DATA_OPEN))), ",")
            vSpec = Left(vSpec, pos1 - 1)
        End If
    End If

    '
    ' Handle validation as specified
    '
    Select Case vSpec
        Case "numeric"
            If VSpecDataDefined Then
                On Error Resume Next
                Dim d As Double
                Dim dLower As Double
                Dim dUpper As Double

                d = CDbl(sValue)
                If Err.number <> 0 Then
                    isValid = False
                Else
                    msgText = "Zahl"
                    isValid = True
                    ' lower bound
                    If UBound(VSpecData) >= 0 Then
                        Select Case VSpecData(0)
                            Case "", "inf", "-inf"
                            Case Else
                                dLower = CDbl(VSpecData(0))
                                msgText = msgText & vbcrlf & "     >= " & dLower
                                isValid = isValid And d >= dLower
                        End Select
                    End If
                    ' upper bound
                    If UBound(VSpecData) >= 1 Then
                        Select Case VSpecData(0)
                            Case "", "inf", "-inf"
                            Case Else
                                dUpper = CDbl(VSpecData(1))
                                msgText = msgText & vbcrlf & "     <= " & dUpper
                                isValid = isValid And d <= dUpper
                        End Select
                    End If
                End If
            Else
                msgText = "Zahl"
                isValid = IsNumeric(sValue)
            End If

        Case Else
            isValid = True
    End Select

    '
    ' return :  true if invalid
    '           false if valid
    '
    validateTextBox = Not isValid

End Function

''
' common function to select a textbox and set focus to it
' even if it sits on a page of a multipage control
'
Private Sub selectControl(ByRef t As Control)
    On Error Resume Next
    With t
        .SelStart = 0
        .SelLength = Len(.text)
        .SetFocus
        Dim p
        Err.Clear
        Set p = t.Parent
        If Err.number <> 0 Then Set p = Nothing
        Do While Not p Is Nothing
            Err.Clear
            If typename(p) = "Page" Then
                p.Parent.value = p.index
            End If
            Err.Clear
            Set p = p.Parent
            If Err.number <> 0 Then Set p = Nothing
        Loop
    End With
    On Error GoTo 0
End Sub

Upvotes: 0

Doug Glancy
Doug Glancy

Reputation: 27478

If it was me, I'd use comboboxes with the choices restricted to your list. For a demo, put a couple comboboxes on a form and add this to its code:

Private Sub UserForm_Activate()
Dim ctl As MSForms.Control
Dim cbo As MSForms.ComboBox
Dim i As Long

For Each ctl In Me.Controls
    If TypeOf ctl Is MSForms.ComboBox Then
        Set cbo = ctl
        With cbo
            .MatchRequired = True
            .Style = fmStyleDropDownList
            .AddItem "Select One"

            For i = 1 To 5
                .AddItem i
            Next i
            If Left(.Name,8)="cboType2" then
                For i = 6 To 10
                    .AddItem i
                Next i
             End If
            .AddItem 88
            If Left(.Name,8)="cboType1" then                
                 .AddItem 99
             End If

            .ListIndex = 0
        End With
    End If
Next ctl
End Sub

EDIT: Added "Select One" line above per conversation in comments.

EDIT 2: Added sample code to distinguish between two types of ComboBoxes - cboType1 and cboType2. Name your ComboBoxes with one of these two prefixes and the code will fill them correctly. Note that there are other ways to do this, e.g., with the ComboBox's Tag property. The point is to be able to distinguish them in code.

Upvotes: 2

Sorceri
Sorceri

Reputation: 8033

Just check the value after they leave the field

Private Sub textbox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim sValue As String
    Dim bInvalid As Boolean
    bInvalid = True
    sValue = Trim(Me.textbox1.Text)
    If sValue = "1" Or sValue = "2" Or sValue = "3" Or sValue = "4" Or sValue = "5" Or sValue = "99" Or sValue = "88" Then
        bInvalid = False
    End If
    If bInvalid Then
        MsgBox "Please enter a valid value"
    End If
End Sub

Here is a solution that utlizes the submit button to validate (commandbutton1), per your recent comments. In the click method it loops through the controls and checks to see if it is a textbox, if so it passes the textbox to be validated. If it fails validation it will set focus back to the control, you may wish to add a message box so the user knows that it failed.

Private Sub CommandButton1_Click()
Dim cntrol As Control
'loop through all the controls
For Each cntrol In Me.Controls
    'check to see if it is a textbox
    If TypeOf cntrol Is MSForms.TextBox Then
        Dim tBox As MSForms.TextBox
        Set tBox = cntrol
        'we have a textbox so validate the entry
        If validateTextBox(tBox) Then
            'did not validate so set focus on the control
            'HERE IS WHERE YOU MAY WISH TO PROVIDE A MESSAGE TO THE USER
            cntrol.SetFocus
            'release the object
            Set tBox = Nothing
            'exit as we do not need to process further
            Exit Sub
        End If
        Set tBox = Nothing
    End If
Next
End Sub




'validate a textbox's value and return true or false
Private Function validateTextBox(tb As MSForms.TextBox) As Boolean
    Dim sValue As String
    Dim bInvalid As Boolean
    bInvalid = True
    sValue = Trim(tb.Text)
    If sValue = "1" Or sValue = "2" Or sValue = "3" Or sValue = "4" Or sValue = "5" Or sValue = "99" Or sValue = "88" Then
        bInvalid = False
    End If
    'return the results
    validateTextBox = bInvalid
End Function

Upvotes: 1

Related Questions