Solved Form Validation using .Tag with highlighted controls on close (1 Viewer)

oxicottin

Just pecking away....
Local time
Today, 12:28
Joined
Jun 26, 2007
Messages
583
Hello, I am trying to validate controls on y form that if their .tag is "Required" and they are null or =0 then highlight the border red and if there is data stay the same. I found a piece of code years ago and am trying to implement it but cant figure out what to change for the below revision.

1) On close I want to run the module below and if there is null or =0 entries then highlight all of them and not just one at a time like the code does as of now.

To call it im using:

'Valadates controls and if data is missing then it cancels close
If VerifyAccidentEntryForm(Me) = True Then
Cancel = True
End If


MODULE:
Code:
Function VerifyAccidentEntryForm(frm As Form) As Boolean

    On Error Resume Next

    Dim ctl As Access.Control
    Dim strErrCtlName As String
    Dim strErrorMessage As String
    Dim strMsgName As String
    Dim lngErrCtlTabIndex As Long
    Dim blnNoValue As Boolean

    lngErrCtlTabIndex = 99999999  'more than max #controls

    For Each ctl In frm.Controls
        With ctl
            Select Case .ControlType
            Case acTextBox, acComboBox, acListBox, acCheckBox, acOptionGroup
                If .Tag = "Required" Then
                    blnNoValue = False
                    If IsNull(.Value) Or .Value = 0 Then 'Added .Value = 0 for comboboxs with default 0
                        blnNoValue = True
                    Else
                        If .ControlType = acTextBox Then
                            If Len(.Value) = 0 Then
                                blnNoValue = True
                            End If
                        End If
                    End If

                    If blnNoValue Then

                        strMsgName = vbNullString
                        If .Controls.Count = 1 Then
                            strMsgName = .Controls(0).Caption
                            If Right$(strMsgName, 1) = ":" Then
                                strMsgName = Trim$(Left$(strMsgName, Len(strMsgName) - 1))
                            End If
                        End If
                        If Len(strMsgName) = 0 Then
                            strMsgName = .Name
                            Select Case Left$(strMsgName, 3)
                            Case "txt", "cbo", "lst", "chk"
                                strMsgName = Mid(strMsgName, 4)
                            End Select
                        End If

                        strErrorMessage = strErrorMessage & vbCr & _
                                        "   " & strMsgName

                        If .TabIndex < lngErrCtlTabIndex Then
                            strErrCtlName = .Name
                            lngErrCtlTabIndex = .TabIndex
                        End If

                    End If
                End If
            Case Else
                ' Ignore this control
            End Select
        End With
    Next ctl
    
    If Len(strErrorMessage) > 0 Then
        MsgBox "The following fields highlighted in red are required before proceding:" & vbCr & _
               strErrorMessage, _
               vbInformation, "Required Fields Are Missing"
              
'Highlight the controls border red
               frm.Controls(strErrCtlName).BorderColor = vbRed
               frm.Controls(strErrCtlName).BorderWidth = 3
              
        frm.Controls(strErrCtlName).SetFocus
        VerifyAccidentEntryForm = True
    Else
        VerifyAccidentEntryForm = False
End If
End Function
 

arnelgp

error reading drive A:
Local time
Tomorrow, 00:28
Joined
May 7, 2009
Messages
9,872
you know, you can only do this on a Single record form?
you first add to a Collection object (or array) the ControlName of the controls in fault.
then recurs through each item in the collection and change the border.
 

Micron

AWF VIP
Local time
Today, 12:28
Joined
Oct 20, 2018
Messages
3,395
That looks rather complicated for what you say you want to do. Aside from that, the thing is, you want to validate data entry on either form BeforeUpdate as a whole, or control BeforeUpdate singularly. Definitely not on form close - especially if the form is based on a recordset count greater than 1. If this is a form like that, as soon as you navigate to another record, the current record is saved regardless of whether or not it passes the test. If it is a single record form as arnel mentions, it's just bad practice to do this on form close IMO.
 

oxicottin

Just pecking away....
Local time
Today, 12:28
Joined
Jun 26, 2007
Messages
583
Its a single record form.... The below works but when I make a selection in one of the named controls it stays red, it does this for every required control until they all have data then I can close the form. How would I get it to remove the red border with every required control?
Code:
Function VerifyAccidentEntryForm(frm As Form) As Boolean
    
    Dim ctl As Access.Control
    Dim strErrCtlName As String
    Dim strErrorMessage As String
    Dim strMsgName As String
    Dim blnNoValue As Boolean
    
    For Each ctl In frm.Controls
        With ctl
            Select Case .ControlType
            Case acTextBox, acComboBox, acListBox, acCheckBox, acOptionGroup
                If .Tag = "Required" Then
                    blnNoValue = False
                    If IsNull(.Value) Or Len(.Value) = 0 Then
                        blnNoValue = True
'Highlight required controls in red
                        .BorderColor = vbRed
                        .BorderWidth = 3
                    End If
                    
                    If blnNoValue Then
                        
                        strMsgName = vbNullString
                        If .Controls.Count = 1 Then
                            strMsgName = .Controls(0).Caption
                            If Right$(strMsgName, 1) = ":" Then
                                strMsgName = Trim$(Left$(strMsgName, Len(strMsgName) - 1))
                            End If
                        End If
                        If Len(strMsgName) = 0 Then
                            strMsgName = .Name
                            Select Case Left$(strMsgName, 3)
                            Case "txt", "cbo", "lst", "chk"
                                strMsgName = Mid(strMsgName, 4)
                            End Select
                        End If
                        
                        strErrorMessage = strErrorMessage & vbCr & _
                        "   " & strMsgName
                        
                    End If
                End If
            Case Else
'Return to origional colors
                .BorderColor = 14270637
                .BorderWidth = 0
            End Select
        End With
        Next ctl
        
        If Len(strErrorMessage) > 0 Then
            MsgBox "The following fields highlighted in red are required before proceding:" & vbCr & _
            strErrorMessage, vbInformation, "Required Fields Are Missing"
            
            VerifyAccidentEntryForm = True
        Else
            VerifyAccidentEntryForm = False
        End If
    End Function
 

Micron

AWF VIP
Local time
Today, 12:28
Joined
Oct 20, 2018
Messages
3,395
That's an interesting perspective. It works....but it doesn't. At the risk of repeating myself, form close is not the place to be doing data validation, regardless of whether it is a single record form or not. You could make this easier on yourself if you just presented a list of controls that need data by using the form BeforeUpdate event. By altering the properties of a control, you have to un-alter them when they subsequently pass the test.

In your posted code, I don't see the point in having 2 or more blocks for a textbox, but I didn't try to grasp what the whole procedure is doing, simply because IMO it's the wrong event. So maybe something like (untested, and assumes that any targeted control has an attached label)
Code modified:

Code:
MyForm_BeforeUpdate Cancel As Integer
Dim ctl as Control
Dim strList As String

On Error GoTo errHandler

strList = ""
For Each ctl in Me.Controls
  If ctl.Tag = "Required" Then
    Select Case ctl.ControlType
      Case acTextBox, acComboBox, acListBox, acCheckBox, acOptionGroup
        If Nz(ctl,"") & 0 = 0 Then
          strList = strList & "- " & ctl.Controls(0).Caption & vbCrLf
          ctl.BorderColor = vbRed
          ctl.BorderWidth = 3
        Else
          ctl.BorderColor = ??
          ctl.BorderWidth = ??
        End If
      Case Else
    End Select
  End If
Next
  
If strList <> "" Then
  Msgbox "Values must be entered for" & vbCrLf & strList & vbCrLf & "which are now bordered in red."
  Cancel = True
End If

exitHere:
Exit Sub

errHandler:
Msgbox "Error " & err.Number & ": " & err.Description
Resume exitHere

End Sub
I don't know what values you'd want for ??
 
Last edited:

oxicottin

Just pecking away....
Local time
Today, 12:28
Joined
Jun 26, 2007
Messages
583
Just to clarify, when i said close i didnt actually mean it we in the "On Close" event i just wanting it to run before i close the form to see if i missed a required control. I do however have the below in the "Before Update" event so it runs it before saving. Sorry if i mislead you guys!


If VerifyAccidentEntryForm(Me) = True Then
Cancel = True
End If
 

arnelgp

error reading drive A:
Local time
Tomorrow, 00:28
Joined
May 7, 2009
Messages
9,872
try this one, only make sure you don't have Event Handler on each control's OnGotFocus.
Code:
Function VerifyAccidentEntryForm(frm As Form) As Boolean
    
    Dim ctl As Access.Control
    Dim strErrCtlName As String
    Dim strErrorMessage As String
    Dim strMsgName As String
    Dim blnNoValue As Boolean
    
    For Each ctl In frm.Controls
        With ctl
            Select Case .ControlType
            Case acTextBox, acComboBox, acListBox, acCheckBox, acOptionGroup
                If .Tag = "Required" Then
                    blnNoValue = False
                    If IsNull(.Value) Or Len(.Value) = 0 Then
                        blnNoValue = True
'Highlight required controls in red
                        .BorderColor = vbRed
                        .BorderWidth = 3
                        .OnGotFocus = "=fncResetColor()"
                    End If
                    
                    If blnNoValue Then
                        
                        strMsgName = vbNullString
                        If .Controls.Count = 1 Then
                            strMsgName = .Controls(0).Caption
                            If Right$(strMsgName, 1) = ":" Then
                                strMsgName = Trim$(Left$(strMsgName, Len(strMsgName) - 1))
                            End If
                        End If
                        If Len(strMsgName) = 0 Then
                            strMsgName = .Name
                            Select Case Left$(strMsgName, 3)
                            Case "txt", "cbo", "lst", "chk"
                                strMsgName = Mid(strMsgName, 4)
                            End Select
                        End If
                        
                        strErrorMessage = strErrorMessage & vbCr & _
                        "   " & strMsgName
                        
                    End If
                End If
            Case Else
'Return to origional colors
                .BorderColor = 14270637
                .BorderWidth = 0
            End Select
        End With
        Next ctl
        
        If Len(strErrorMessage) > 0 Then
            MsgBox "The following fields highlighted in red are required before proceding:" & vbCr & _
            strErrorMessage, vbInformation, "Required Fields Are Missing"
            
            VerifyAccidentEntryForm = True
        Else
            VerifyAccidentEntryForm = False
        End If
    End Function


Public Function fncResetColor()
    Dim frm As Form
    Dim ctl As Control
    Set frm = Screen.ActiveControl.Parent
    For Each ctl In frm.Controls
        With ctl
            Select Case .ControlType
            Case acTextBox, acComboBox, acListBox, acCheckBox, acOptionGroup
                If .Tag = "Required" Then
                    .BorderColor = 14270637
                    .BorderWidth = 0
                    .OnGotFocus = ""
                End If
            End Select
        End With
    Next
End Function
 

arnelgp

error reading drive A:
Local time
Tomorrow, 00:28
Joined
May 7, 2009
Messages
9,872
another variation is to remove the red border for the control which has focus.
so it will leave the other (no value + tag="required", control) as red (so you know that it is still not being filed):
Code:
Function VerifyAccidentEntryForm(frm As Form) As Boolean
    
    Dim ctl As Access.Control
    Dim strErrCtlName As String
    Dim strErrorMessage As String
    Dim strMsgName As String
    Dim blnNoValue As Boolean
    
    For Each ctl In frm.Controls
        With ctl
            Select Case .ControlType
            Case acTextBox, acComboBox, acListBox, acCheckBox, acOptionGroup
                If .Tag = "Required" Then
                    blnNoValue = False
                    If IsNull(.Value) Or Len(.Value) = 0 Then
                        blnNoValue = True
'Highlight required controls in red
                        .BorderColor = vbRed
                        .BorderWidth = 3
                        .OnGotFocus = "=fncResetColor()"
                    End If
                    
                    If blnNoValue Then
                        
                        strMsgName = vbNullString
                        If .Controls.Count = 1 Then
                            strMsgName = .Controls(0).Caption
                            If Right$(strMsgName, 1) = ":" Then
                                strMsgName = Trim$(Left$(strMsgName, Len(strMsgName) - 1))
                            End If
                        End If
                        If Len(strMsgName) = 0 Then
                            strMsgName = .Name
                            Select Case Left$(strMsgName, 3)
                            Case "txt", "cbo", "lst", "chk"
                                strMsgName = Mid(strMsgName, 4)
                            End Select
                        End If
                        
                        strErrorMessage = strErrorMessage & vbCr & _
                        "   " & strMsgName
                        
                    End If
                End If
            Case Else
'Return to origional colors
                .BorderColor = 14270637
                .BorderWidth = 0
            End Select
        End With
        Next ctl
        
        If Len(strErrorMessage) > 0 Then
            MsgBox "The following fields highlighted in red are required before proceding:" & vbCr & _
            strErrorMessage, vbInformation, "Required Fields Are Missing"
            
            VerifyAccidentEntryForm = True
        Else
            VerifyAccidentEntryForm = False
        End If
    End Function


Public Function fncResetColor()
    Dim frm As Form
    Dim ctl As Control
    Set frm = Screen.ActiveControl.Parent
    For Each ctl In frm.Controls
        With ctl
            Select Case .ControlType
            Case acTextBox, acComboBox, acListBox, acCheckBox, acOptionGroup
                If .Tag = "Required" And .Name = Screen.ActiveControl.Name Then
                    .BorderColor = 14270637
                    .BorderWidth = 0
                    .OnGotFocus = ""
                    Exit For
                End If
            End Select
        End With
    Next
End Function
 

oxicottin

Just pecking away....
Local time
Today, 12:28
Joined
Jun 26, 2007
Messages
583
Thanks arnelgp Ill give it a try... I wont be able to try it for a few days though, Ill post back!
 

oxicottin

Just pecking away....
Local time
Today, 12:28
Joined
Jun 26, 2007
Messages
583
arnelgp, I had some time to give it a try and I am receiving an:

Run-time error '438'
Object Doesn't support this property or method

Debug takes me to the fncResetColor() .OnGotFocus = ""

That's the first example you gave, the second one gives an error as well and takes me to the .OnGotFocus as well.
 

arnelgp

error reading drive A:
Local time
Tomorrow, 00:28
Joined
May 7, 2009
Messages
9,872
I don't have error on that line.
anyway just comment out the line:

...
...
.BorderColor = 14270637
.BorderWidth = 0
'.OnGotFocus = ""
...
...
 

oxicottin

Just pecking away....
Local time
Today, 12:28
Joined
Jun 26, 2007
Messages
583
I commented out your suggestion and now I still get the same error 438 but debug takes me to:

.OnGotFocus = "=fncResetColor()"
 

arnelgp

error reading drive A:
Local time
Tomorrow, 00:28
Joined
May 7, 2009
Messages
9,872
did you put the 2 functions in Separate Module? you should.
 

oxicottin

Just pecking away....
Local time
Today, 12:28
Joined
Jun 26, 2007
Messages
583
Its in two separate modules and still same error. It works perfectly if I remove the "Required" from my option group. How can I get it to work with my option group?
 

arnelgp

error reading drive A:
Local time
Tomorrow, 00:28
Joined
May 7, 2009
Messages
9,872
I found the problem.
the OptionGroup don't have the .OnGotFocus event.

re-instate all code (remove the ' comment mark).
replace .OnGotFocus with .OnEnter
 

oxicottin

Just pecking away....
Local time
Today, 12:28
Joined
Jun 26, 2007
Messages
583
Well now I'm getting a different error shown in image. Debug takes me to:

.OnEnter = "=fncResetColor()"


Code:
Function VerifyAccidentEntryForm(frm As Form) As Boolean   
    Dim ctl As Access.Control
    Dim strErrCtlName As String
    Dim strErrorMessage As String
    Dim strMsgName As String
    Dim blnNoValue As Boolean
    
    For Each ctl In frm.Controls
        With ctl
            Select Case .ControlType
            Case acTextBox, acComboBox, acListBox, acCheckBox, acOptionGroup
                If .Tag = "Required" Then
                    blnNoValue = False
                    If IsNull(.Value) Or Len(.Value) = 0 Then
                        blnNoValue = True
'Highlight required controls in red
                        .BorderColor = vbRed
                        .BorderWidth = 3
                        .OnEnter = "=fncResetColor()"
                    End If
                    
                    If blnNoValue Then
                        
                        strMsgName = vbNullString
                        If .Controls.Count = 1 Then
                            strMsgName = .Controls(0).Caption
                            If Right$(strMsgName, 1) = ":" Then
                                strMsgName = Trim$(Left$(strMsgName, Len(strMsgName) - 1))
                            End If
                        End If
                        If Len(strMsgName) = 0 Then
                            strMsgName = .Name
                            Select Case Left$(strMsgName, 3)
                            Case "txt", "cbo", "lst", "chk"
                                strMsgName = Mid(strMsgName, 4)
                            End Select
                        End If
                        
                        strErrorMessage = strErrorMessage & vbCr & _
                        "   " & strMsgName
                        
                    End If
                End If
            Case Else
'Return to origional colors
                .BorderColor = 14270637
                .BorderWidth = 0
            End Select
        End With
        Next ctl
        
        If Len(strErrorMessage) > 0 Then
            MsgBox "The following fields highlighted in red are required before proceding:" & vbCr & _
            strErrorMessage, vbInformation, "Required Fields Are Missing"
            
            VerifyAccidentEntryForm = True
        Else
            VerifyAccidentEntryForm = False
        End If
    End Function

Public Function fncResetColor()
    Dim frm As Form
    Dim ctl As Control
    Set frm = Screen.ActiveControl.Parent
    For Each ctl In frm.Controls
        With ctl
            Select Case .ControlType
            Case acTextBox, acComboBox, acListBox, acCheckBox, acOptionGroup
                If .Tag = "Required" And .Name = Screen.ActiveControl.Name Then
                    .BorderColor = 14270637
                    .BorderWidth = 0
                    .OnEnter = ""
                    Exit For
                End If
            End Select
        End With
    Next
End Function
 

Attachments

arnelgp

error reading drive A:
Local time
Tomorrow, 00:28
Joined
May 7, 2009
Messages
9,872
Press debug to see which function has duplicate declararion.
 

oxicottin

Just pecking away....
Local time
Today, 12:28
Joined
Jun 26, 2007
Messages
583
arnelgp, that worked thank you so much!
 

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

Top Bottom