The following code is my attempt at a generalized input verification for numerical data entered into TextBoxes. The code is designed to be called from the Before_Update event of a text box. The programmer calls the function with the text value to be tested, the type of value it should be and optionally lower & upper limits on the data.
Calling Examples:
[Code]Private Sub tbOdometer_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
‘Calls: [Functions]bVerifyTextBoxNumber
Dim bOdometerGood As Boolean
‘*** Locate last Odometer Reading ***’
[b65535].Select
Selection.End(xlUp).Select
bOdometerGood = bVerifyTextBoxNumber(vbSingle, tbOdometer.Value, ActiveCell.Value)
If Not bOdometerGood Then
MsgBox “Odometer Reading is not a valid number” & vbCrLf & _
“or Odometer Reading is less than or equal to previous reading” & _
vbCrLf & vbCrLf & “Please Correct…”, vbOKOnly + vbCritical, _
“Error: Invalid Odometer Reading”
Cancel = True
End If
End Sub
Private Sub tbGallons_beforeupdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim bGallonsGood As Boolean
Dim vGallons As Variant
Dim vMinGals As Variant
If UCase(ActiveSheet.Name) = “FIT” Then
vGallons = “10.4” ‘*** Fit Capacity
Else
vGallons = “90” ‘*** Expedition Capacity
End If
vMinGals = 2
bGallonsGood = bVerifyTextBoxNumber(vbSingle, tbGallons.Value, 1, vGallons)
If Not bGallonsGood Then
MsgBox “The number of gallons entered {” & tbGallons.Value & “}” & vbCrLf & _
“is not within the acceptable range of ” & vMinGals & ” to ” & vGallons & “.”, _
vbOKOnly + vbCritical, “Error: Gallons entry invalid”
Cancel = True
End If
End Sub
[/Code]
It will return True if the tests are passed and False if not. It is up to the programmer to then issue the appropriate error message if necessary. See the notes in the function header for more usage info.
The constant cModeDebug at the top of the procedure is used by the programmer to debug his calls to the procedure. It should be set to True while testing the code and to False when the code has passed coding. This will help trap errors where the upper limit passed to the function is less than the lower limit and provide appropriate messages.
Your comments and suggestions for improvement are requested.
[Code]Option Explicit
#Const cModeDebug = False ‘*** Set to True when debugging & False for Production
‘ +————————-+ +———-+
‘————————-| bVerifyTextBoxNumber() |————-| 08/20/10 |
‘ +————————-+ +———-+
‘Called by: Any procedure needing to verify numeric input!
‘Notes: This routine only verifies numbers NOT DATES!
‘ If the optional arguments are used for Lower & Upper Limits
‘ the values passed are considered INVALID entries, i.e. a lower limit of
‘ Zero will NOT allow a Zero value entry! and an upper limit of 1,000 will
‘ NOT allow a value greater than 999 for whole numbers and 999.999… for
‘ Single, Double, and Currency types. If passing only an upper limit you
‘ must include the commas, i.e.
‘ –> bVerifyTextBoxNumber(iDatatype,zStrValue,,vUpperLimit)
‘ Conversion functions, e.g. CInt & CLng round funny…
‘ If the fractional part is EXACTLY .5 they round to the nearest
‘ EVEN number, thus; 2.5 rounds to 2 while 3.5 rounds to 4!
‘ This function, despite it’s name can also be used to verify input
‘ from the INPUTBOX function.
Public Function bVerifyTextBoxNumber(iDataType As Integer, zStrValue, _
Optional vLowerLimit As Variant, _
Optional vUpperLimit As Variant) As Boolean
Dim bErrNumeric As Boolean
Dim bErrCommas As Boolean
Dim zDatatypes(18) As String
Dim zErrorData As String
zDatatypes(0) = “vbEmpty”
zDatatypes(1) = “vbNull”
zDatatypes(2) = “vbInteger”
zDatatypes(3) = “vbLong”
zDatatypes(4) = “vbSingle”
zDatatypes(5) = “vbDouble”
zDatatypes(6) = “vbCurrency”
zDatatypes(7) = “vbDate”
zDatatypes(8) = “vbString”
zDatatypes(9) = “vbObject”
zDatatypes(10) = “vbError”
zDatatypes(11) = “vbBoolean”
zDatatypes(12) = “Unknown”
zDatatypes(13) = “vbDataObject”
zDatatypes(14) = “vbDecimal”
zDatatypes(15) = “Unknown”
zDatatypes(16) = “Unknown”
zDatatypes(17) = “vbByte”
On Error GoTo ErrorTrap:
bVerifyTextBoxNumber = True
bErrNumeric = False
bErrNumeric = Not IsNumeric(zStrValue)
bErrCommas = InStr(zStrValue, “,,”) > 0
If bErrNumeric Or bErrCommas Then
bVerifyTextBoxNumber = False
Exit Function
End If
#If cModeDebug Then ‘*** Construct Debug message ***
zErrorData = “Lower Limit is GREATER than or Equal to Upper Limit!” & _
vbCrLf & vbCrLf & “Data Type Requested: ” & vbTab & zDatatypes(iDataType) & _
vbCrLf & “Data Value Passed: ” & vbTab & vbTab & zStrValue & vbCrLf & _
“Lower Limit Passed: ” & vbTab & vbTab & _
IIf(Not IsMissing(vLowerLimit), vLowerLimit, “None”) & vbCrLf & _
“Upper Limit Passed: ” & vbTab & vbTab & _
IIf(Not IsMissing(vUpperLimit), vUpperLimit, “None”)
#End If
Select Case iDataType
Case vbCurrency
If Not IsMissing(vLowerLimit) Then
If CCur(zStrValue) = CCur(vUpperLimit) Then
bVerifyTextBoxNumber = False
End If
End If
#If cModeDebug Then
If (Not IsMissing(vLowerLimit)) And _
(Not IsMissing(vUpperLimit)) Then
If CCur(vLowerLimit) >= CCur(vUpperLimit) Then
MsgBox zErrorData, vbOKOnly + vbCritical, _
“bVerifyTextBoxNumber()- Error: Invalid Call to Function”
End If
End If
#End If
Case vbSingle
If Not IsMissing(vLowerLimit) Then
If CSng(zStrValue) = CSng(vUpperLimit) Then
bVerifyTextBoxNumber = False
End If
End If
#If cModeDebug Then
If (Not IsMissing(vLowerLimit)) And _
(Not IsMissing(vUpperLimit)) Then
If CSng(vLowerLimit) >= CSng(vUpperLimit) Then
MsgBox zErrorData, vbOKOnly + vbCritical, _
“bVerifyTextBoxNumber()- Error: Invalid Call to Function”
End If
End If
#End If
Case vbDouble
If Not IsMissing(vLowerLimit) Then
If CDbl(zStrValue) = CDbl(vUpperLimit) Then
bVerifyTextBoxNumber = False
End If
End If
#If cModeDebug Then
If (Not IsMissing(vLowerLimit)) And _
(Not IsMissing(vUpperLimit)) Then
If CDbl(vLowerLimit) >= CDbl(vUpperLimit) Then
MsgBox zErrorData, vbOKOnly + vbCritical, _
“bVerifyTextBoxNumber()- Error: Invalid Call to Function”
End If
End If
#End If
Case vbInteger
If Not IsMissing(vLowerLimit) Then
If CInt(zStrValue) = CInt(vUpperLimit) Then
bVerifyTextBoxNumber = False
End If
End If
#If cModeDebug Then
If (Not IsMissing(vLowerLimit)) And _
(Not IsMissing(vUpperLimit)) Then
If CInt(vLowerLimit) >= CInt(vUpperLimit) Then
MsgBox zErrorData, vbOKOnly + vbCritical, _
“bVerifyTextBoxNumber()- Error: Invalid Call to Function”
End If
End If
#End If
Case vbLong
If Not IsMissing(vLowerLimit) Then
If CLng(zStrValue) = CLng(vUpperLimit) Then
bVerifyTextBoxNumber = False
End If
End If
#If cModeDebug Then
If (Not IsMissing(vLowerLimit)) And _
(Not IsMissing(vUpperLimit)) Then
If CLng(vLowerLimit) >= CLng(vUpperLimit) Then
MsgBox zErrorData, vbOKOnly + vbCritical, _
“bVerifyTextBoxNumber()- Error: Invalid Call to Function”
End If
End If
#End If
Case Else
MsgBox “The data type { ” & zDatatypes(iDataType) & _
” } is not supported by the bVerifyTextBoxNumber function.” & _
vbCrLf & “Supported datatypes:” & vbCrLf & _
“vbCurrency; vbDouble; vbInteger;” & vbCrLf & _
“vbLong; and vbSingle”, _
vbOKOnly + vbCritical, _
“bVerifyTextBoxNumber()- Error: Unsupported Data Type”
bVerifyTextBoxNumber = False
End Select ‘*** Case iDataType ***
Exit Function
ErrorTrap:
zErrorData = “Data Type Requested: ” & vbTab & zDatatypes(iDataType) & vbCrLf & _
“Data Value Passed: ” & vbTab & vbTab & zStrValue & vbCrLf & _
“Lower Limit Passed: ” & vbTab & vbTab & _
IIf(Not IsMissing(vLowerLimit), vLowerLimit, “None”) & vbCrLf & _
“Upper Limit Passed: ” & vbTab & vbTab & _
IIf(Not IsMissing(vUpperLimit), vUpperLimit, “None”)
Select Case Err()
Case 6: ‘*** OverFlow Error – Number too large for type ***
MsgBox “One of the arguments passed caused an Overflow error:” & _
vbCrLf & zErrorData, _
vbCritical + vbOKOnly, _
“bVerifyTextBoxNumber()- Error: Argument out of Range”
Exit Function
Case 13: ‘*** Type Mismatch Error – Can’t convert to number ***
MsgBox “One of the arguments passed caused an Type Mismatch error:” & _
vbCrLf & zErrorData, _
vbCritical + vbOKOnly, _
“bVerifyTextBoxNumber()- Error: Argument out of Range”
Exit Function
Case Else
MsgBox “Error Number: ” & Format(Err.Number) & vbCrLf & _
“Error Description: ” & Err.Description & vbCrLf & vbCrLf & _
“Contact your system programmer immediately!” & vbCrLf & vbCrLf & _
zErrorData, vbOKOnly + vbCritical, _
“bVerifyTextBoxNumber()- Error: Unknown Error”
End Select
End Function ‘*** bVerifyTextBoxNumber ***
[/Code]
