Un-highlighting Required Fields

MHamid

Active Member
Joined
Jan 31, 2013
Messages
472
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
 
I disabled Allen's code for required fields and used yours in the Form's Current event.
I am getting an error message "The expression On Lost Focus you entered as the event property setting produced the following error: The expression you entered has a function name that [database name] can't find."

I updated the code to:
Code:
Dim ctl As Access.Control
    For Each ctl In Me.Controls
        With ctl
            Select Case .ControlType
                Case acTextBox, acComboBox, acListBox
                    If (.Tag = "*") And (Len(ctl & "") = 0) Then
                        .BackColor = REQUIRED_BACKCOLOR
                        '.OnLostFocus = "=Hilight([" & .Name & "], False)"
                    Else
                        .BackColor = DEFAULT_BACKCOLOR
                    End If
            End Select
        End With
    Next

and I am no longer seeing that error message.
However, the required fields control are still staying as red after is has been changed from null (blank) to a value.
Also, the other issue I am having is that when I add this record and leave a required field blank, there is nothing to trap and the record is being added with a blank required field. I need this required field to be filled. Therefore, I will need a message box.

I was attempting to tweak a code to include a message box, but it is not working.

Code:
Private Sub Form_BeforeUpdate(cancel As Integer)
Dim ctl As Access.Control
Dim msg As String, Style As Integer, Title As String
Dim nl As String
If Me.NewRecord Then
    For Each ctl In Me.Controls
        With ctl
            Select Case .ControlType
                Case acTextBox, acComboBox, acListBox
                    If ctl.Tag = "*" And ctl.Name = "" Then
                        msg = "Data Required for '" & ctl.Name & "' field!" & nl & _
                        "You can't save this record until this data is provided!" & nl & _
                        "Enter the data and try again . . . "
                        Style = vbCritical + vbOKOnly
                        Title = "Required Data..."
                        MsgBox msg, Style, Title
                        ctl.SetFocus
                        cancel = True
                    End If
            End Select
        End With
    Next
End If
 
Upvote 0

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
I updated the code to:
when you did this you changed back to Allen's code so it won't do anything new.

My function is right there - but it has to be in the form. did you put this in the form?

In your other code where you try to have a message box there is this line:
If ctl.Tag = "*" And ctl.Name = "" Then
that looks wrong to me - no control should have a blank name.
 
Last edited:
Upvote 0
I changed the code back to what you originally gave me. I added the function in the form as well. It is under the Form_Current event.
I am getting the error message I am getting an error message "The expression On Lost Focus you entered as the event property setting produced the following error: The expression you entered has a function name that [database name] can't find.".

In your Function code, I see
Code:
Dim strBackColor As String
but I don't see it being used in the function itself.


Also, I thought that ctl.Name was the wrong one to use. What is the correct code to check if the field is blank?
 
Last edited:
Upvote 0
this might work:
Code:
If ctl.Tag = "*" And len(ctl & "") = 0 Then

for the lost focus error, you should figure out what control is erroring and what function it is trying to find (that it can't find).
 
Last edited:
Upvote 0
Ok, I see why I was getting that message. Allen's hilight code was in the OnLostFocus and OnGotFocus events.
And now for some reason your code is doing nothing at all ...
 
Upvote 0
I deleted Allen's code completely and am solely using yours now. There was something else in the Tag line besides the asterisk (*). So I deleted any extra notations and just kept it as just the asterisk (*) for the required fields and now your code works perfectly

I also made the update for the message box and it works!!!

I tested the message box and after I leave two required fields blank, after the message boxes pop up I get an error message stating 'Error 2105: You can't go to the specified record". Is there a way to trap this error so it won't show up?
 
Upvote 0
FYI - This is the code I am using with an error handler.

Code:
Private Sub AddRecord_Click()
On Error GoTo errHandler
Dim ID As Long
'blnGood = True
    ID = DMax("RefID", "QAMaster")
'If Not Me.NewRecord Then
    DoCmd.GoToRecord , , acNewRec
'End If
    Me.Approved = DLookup("ApprovedBy", "QAMaster", "RefID=" & ID)
    Me.CycleMonth = DLookup("CycleMonth", "QAMaster", "RefID=" & ID)
    Me.DateReviewed = DLookup("DateReviewed", "QAMaster", "RefID=" & ID)
    Me.ReportType = DLookup("ReportType", "QAMaster", "RefID=" & ID)
    Me.MainSection = DLookup("MainSection", "QAMaster", "RefID=" & ID)
    Me.TopicSection = DLookup("TopicSection", "QAMaster", "RefID=" & ID)
    Me.ReviewerType = DLookup("ReviewerType", "QAMaster", "RefID=" & ID)
    Me.Reviewer = DLookup("Reviewer", "QAMaster", "RefID=" & ID)
    Me.ReviewerReportArea = DLookup("ReviewerReportArea", "QAMaster", "RefID=" & ID)
    Me.Individual = DLookup("OwnershipIndividual", "QAMaster", "RefID=" & ID)
    Me.Team = DLookup("OwnershipTeam", "QAMaster", "RefID=" & ID)
    Me.txtHyperlink = DLookup("Hyperlink", "QAMaster", "RefID=" & ID)
    Me.EnteredBy = Environ("USERNAME")
    Me.DateEntered = Format(DateValue(Now()), "Short Date")
    Me.CycleMonth.SetFocus
    Me.DateReviewed.SetFocus
    Me.ReportType.SetFocus
    Me.MainSection.SetFocus
    Me.TopicSection.SetFocus
    Me.ReviewerType.SetFocus
    Me.Reviewer.SetFocus
    Me.ReviewerReportArea.SetFocus
    Me.Individual.SetFocus
    Me.txtHyperlink.SetFocus
    Me.txtCount.SetFocus
'blnGood = False
    Me.txtOther.Visible = False
    Me.txtOther2.Visible = False
    
    
exitHere:
Exit Sub
errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume exitHere

End Sub
 
Upvote 0
it looks like you have commented out the if and end if part:
Code:
'If Not Me.NewRecord Then
    DoCmd.GoToRecord , , acNewRec
'End If

That should be uncommented:
Code:
If Not Me.NewRecord Then
    DoCmd.GoToRecord , , acNewRec
End If
 
Upvote 0
That is commented out on purpose because if I "uncomment" it, then the code will not work when creating a new record. I don't need that if statement.

I tested it again by leaving 3 required fields blank and I got an error message statsing "run-time error '2110': [Database name] can't move focus to the control ListboxL2.

That particular control is hidden until an option in L1 has been selected.

The part of the code that it errors out at is in red below:
Code:
Private Sub Form_BeforeUpdate(cancel As Integer)
'Dim strMsg As String
Dim ctl As Access.Control
Dim msg As String, Style As Integer, Title As String
Dim nl As String
If Me.NewRecord Then
    For Each ctl In Me.Controls
        With ctl
            Select Case .ControlType
                Case acTextBox, acComboBox, acListBox
                    If ctl.Tag = "*" And Len(ctl & "") = 0 Then
                        msg = "Data Required for '" & ctl.Name & "' field!" & nl & _
                        "You can't save this record until this data is provided!" & nl & _
                        "Enter the data and try again . . . "
                        Style = vbCritical + vbOKOnly
                        Title = "Required Data..."
                        MsgBox msg, Style, Title
                       [COLOR=#FF0000] ctl.SetFocus[/COLOR]
                        cancel = True
                    End If
            End Select
        End With
    Next
End If
 
Last edited:
Upvote 0
maybe something like IF Control is not hidden Then set focus otherwise do nothing. I don't think a field that is potentially hidden from the user should be required anyway ... how are they supposed to give it a value if they can't see it?

as far as the moving to a new record, I thought we saw this before and the error was trying to move to a new record when you are already on a new record. Since that's not possible, you can't run that line of code when you are on a new record.
 
Upvote 0

Forum statistics

Threads
1,213,487
Messages
6,113,938
Members
448,534
Latest member
benefuexx

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
Back
Top