Option Explicit
Option Compare Text
Public Const conGotFocusColor As Long = vbRed
Public Sub InitializeGotLostFocus(ByRef frmThisForm As Form)
    Dim lngIndex   As Long
    Dim ctlControl As Control
    
    For Each ctlControl In frmThisForm
        With ctlControl
            Select Case .ControlType
                Case acOptionGroup
                    For lngIndex = 1 To .Controls.Count - 2 Step 2
                        frmThisForm(.Controls.Item(lngIndex).Name).OnGotFocus = MakeFunctionCall("HandleFocusChange", frmThisForm.Name, .Controls.Item(lngIndex + 1).Name, "Got Focus")
                        frmThisForm(.Controls.Item(lngIndex).Name).OnLostFocus = MakeFunctionCall("HandleFocusChange", frmThisForm.Name, .Controls.Item(lngIndex + 1).Name, "Lost Focus")
                        frmThisForm(.Controls.Item(lngIndex + 1).Name).BackStyle = 1
                    Next lngIndex
                
                Case acTextBox
                    .OnGotFocus = MakeFunctionCall("HandleFocusChange", frmThisForm.Name, .Name, "Got Focus")
                    .OnLostFocus = MakeFunctionCall("HandleFocusChange", frmThisForm.Name, .Name, "Lost Focus")
                    .BackStyle = 1
                
            End Select
        End With
    Next ctlControl
End Sub
Public Function HandleFocusChange(ByVal strFormName As String, _
                                  ByVal strControlName As String, _
                                  ByVal strGotLost As String)
    Static lngBackColor As Long
    
    If strGotLost = "Got Focus" Then
        lngBackColor = Forms(strFormName)(strControlName).BackColor
        Forms(strFormName)(strControlName).BackColor = conGotFocusColor
    Else
        Forms(strFormName)(strControlName).BackColor = lngBackColor
    End If
    
End Function
Public Function MakeFunctionCall(ByVal strFunctionName As String, _
                            ParamArray ArgList() As Variant) As String
    Dim lngElement  As Long
    Dim strFunction As String
    
    '   The first argument is NOT optional.
    strFunction = "=" & strFunctionName & "("
    
    '   All the remaining arguments are optional.
    '   Loop through argument range, if passed.
    For lngElement = LBound(ArgList) To UBound(ArgList)
        strFunction = strFunction & Chr$(34) & ArgList(lngElement) & Chr$(34) & ", "
    Next lngElement
                                 
    '   Did we receive any arguments?
    '   If so, trim off trailing ", ".
    If Right$(strFunction, 2) = ", " Then
        strFunction = Left$(strFunction, Len(strFunction) - 2)
    End If
    
    MakeFunctionCall = strFunction & ")"
                                 
End Function