Reputation:
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
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
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
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