Un-highlighting Required Fields

MHamid

Active Member
Joined
Jan 31, 2013
Messages
385
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hello,

I am trying a different approach to handle required fields. I'm testing another code and where it highlights required fields works great. However, I need it to un-highlight after the required field has been filled. Below is the code that handles the required fields. Any suggestions?

Code:
Public Function SetupRequiredFields(frm As Form)
On Error GoTo Err_Handler

    Dim rs As DAO.Recordset     'Recordset of the form.
    Dim ctl As Access.Control   'Each control on the form.
    Dim strField As String      'Name of the field a control is bound to.
    
    Set rs = frm.Recordset
    For Each ctl In frm.Controls
        Select Case ctl.ControlType
        Case acTextBox, acComboBox, acListBox
            'Ignore unbound, or bound to an expression.
            strField = ctl.ControlSource
            If (strField <> vbNullString) And Not (strField Like "=*") Then
                With rs(strField)
                    If (.Required) Or (.ValidationRule Like "*Is Not Null*") Then
                        ctl.BackColor = mlngcRequiredBackColor
                        Call MarkAttachedLabel(ctl)
                    End If
                End With
            End If
        End Select
    Next
    SetupRequiredFields = True
    
Exit_Handler:
    Set ctl = Nothing
    Set rs = Nothing
    Exit Function
Err_Handler:
    MsgBox "Error " & err.Number & ": " & err.Description, vbExclamation, "SetupRequiredFields()"
    Resume Exit_Handler
End Function

Below is the full code that has been placed in a Module
Code:
Option Compare Database
Option Explicit

'The RGB value to use as a control's Back Color when it has focus.
Private Const mlngcFocusBackColor = &HB0FFFF
'The RGB value to use as Back Color if a control is bound to a required field.
Private Const mlngcRequiredBackColor = &HD0D0FF
'These constants are for assigning/reading the Tag property.
Private Const mstrcTagBackColor = "UsualBackColor"
Private Const mstrcTagSeparator = ";"
Private Const mstrcTagAssignmnent = "="

Public Function SetupForm(frm As Form, Optional iSetupWhat As Integer = &H7FFF)
    Const iSetupRequired = 1
    Const iSetupFocusColor = 2
    
    If (iSetupWhat And iSetupRequired) Then Call SetupRequiredFields(frm)
    If (iSetupWhat And iSetupFocusColor) Then Call SetupFocusColor(frm)
End Function

Public Function SetupFocusColor(frm As Form)
On Error GoTo Err_Handler

    Dim ctl As Access.Control   'Each control on the form.
    
    For Each ctl In frm.Controls
        With ctl
            Select Case .ControlType
            Case acTextBox, acComboBox, acListBox
                If (.OnGotFocus = vbNullString) And (.OnLostFocus = vbNullString) Then
                    .OnGotFocus = "=Hilight([" & .Name & "], True)"
                    .OnLostFocus = "=Hilight([" & .Name & "], False)"
                    .Tag = .Tag & IIf(.Tag <> vbNullString, mstrcTagSeparator, Null) & _
                        mstrcTagBackColor & mstrcTagAssignmnent & .BackColor
                End If
            End Select
        End With
    Next
    SetupFocusColor = True
    
Exit_Handler:
    Set ctl = Nothing
    Exit Function
Err_Handler:
    MsgBox "Error " & err.Number & ": " & err.Description, vbExclamation, "SetupFocusColor()"
    Resume Exit_Handler
End Function

Public Function SetupRequiredFields(frm As Form)
On Error GoTo Err_Handler

    Dim rs As DAO.Recordset     'Recordset of the form.
    Dim ctl As Access.Control   'Each control on the form.
    Dim strField As String      'Name of the field a control is bound to.
    
    Set rs = frm.Recordset
    For Each ctl In frm.Controls
        Select Case ctl.ControlType
        Case acTextBox, acComboBox, acListBox
            'Ignore unbound, or bound to an expression.
            strField = ctl.ControlSource
            If (strField <> vbNullString) And Not (strField Like "=*") Then
                With rs(strField)
                    If (.Required) Or (.ValidationRule Like "*Is Not Null*") Then
                        ctl.BackColor = mlngcRequiredBackColor
                        Call MarkAttachedLabel(ctl)
                    End If
                End With
            End If
        End Select
    Next
    SetupRequiredFields = True
    
Exit_Handler:
    Set ctl = Nothing
    Set rs = Nothing
    Exit Function
Err_Handler:
    MsgBox "Error " & err.Number & ": " & err.Description, vbExclamation, "SetupRequiredFields()"
    Resume Exit_Handler
End Function

Public Function Hilight(ctl As Access.Control, bOn As Boolean)

    '           bOn = flag: True if receiving focus, False if losing focus.
    Dim strBackColor As String
    
    If bOn Then
        'Assign the 'got focus' color.
        ctl.BackColor = mlngcFocusBackColor
    Else
        'Restore the color from the control's Tag property (white if not found.)
        strBackColor = ReadFromTag(ctl, mstrcTagBackColor)
        If IsNumeric(strBackColor) Then
            ctl.BackColor = Val(strBackColor)
        Else
            ctl.BackColor = vbWhite
        End If
    End If
End Function

Private Function MarkAttachedLabel(ctl As Access.Control)
On Error GoTo Err_Handler
    
    With ctl.Controls(0)
        If Not .Caption Like "*
[*]" Then
            .Caption = .Caption & "*"
            .FontBold = True
            .ForeColor = vbRed
        End If
    End With
Exit_Handler:
    Exit Function
Err_Handler:
    Resume Exit_Handler
End Function

Private Function ReadFromTag(ctl As Control, strName As String) As String

    Dim varArray As Variant
    Dim strValue As String
    Dim i As Long
    
    If ctl.Tag <> vbNullString Then
        varArray = Split(ctl.Tag, mstrcTagSeparator)
        If IsArray(varArray) Then
            For i = LBound(varArray) To UBound(varArray)
                If varArray(i) Like strName & mstrcTagAssignmnent & "*" Then
                    ReadFromTag = Mid(varArray(i), Len(strName) + Len(mstrcTagAssignmnent) + 1&)
                End If
            Next
        End If
    End If
End Function

The code is being called in the Form_Load event.
FYI - this is someone else's code I found online and wanted to try out.

Thank you
 

MHamid

Active Member
Joined
Jan 31, 2013
Messages
385
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
How can I update your code to accommodate for multiple values in the tag property field?

This is what I tried to update it to, but it' snot working.

Code:
Private Sub Form_Current()
Dim ctl As Access.Control
    For Each ctl In Me.Controls
        With ctl
            Select Case .ControlType
                Case acTextBox, acComboBox, acListBox
                    [COLOR=#FF0000]If InStr(ctl.Tag, "*") = "*" And (Len(ctl & "") = 0) Then[/COLOR]
                        .BackColor = REQUIRED_BACKCOLOR
                        .OnLostFocus = "=Highlight([" & .Name & "])"
                    Else
                        .BackColor = DEFAULT_BACKCOLOR
                    End If
            End Select
        End With
    Next

The line in red used to be:
Code:
If (.Tag = "*") And (Len(ctl & "") = 0) Then
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.

xenou

MrExcel MVP
Joined
Mar 2, 2007
Messages
16,832
Office Version
  1. 2019
Platform
  1. Windows
Instr returns a number, not the string sought:

try:
Code:
If InStr(ctl.Tag, "*") > 0 And (Len(ctl & "") = 0) Then
 

MHamid

Active Member
Joined
Jan 31, 2013
Messages
385
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
YES!!! This worked perfectly. Thank you so much.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,380
Messages
5,641,796
Members
417,239
Latest member
AymericA

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top