HOWTO: Navigate to next/previous conditionally formatted record

[Malcolm Cook]

I offer this approach to extending Access's capabilities and welcome and criticism of the utility of the tool, the approach to
providing it and the implementation.

Malcolm Cook
Stowers Institute for Medical Research - Kansas City, MO USA


Public Function cmdFindConditionallyFormatted(Optional vSearchDirection As Variant)
'PURPOSE: allow the database user to easily navigate to the next or previous
' record that passes the conditions defined using Access' native conditional formatting
' Find the next row in the current form whose which satisfied the conditional format criteria
' of the current control.
' If no such row, beep and stay put.
' Search according to vSearchDirection, where 'acUp' means 'after' the position of Access's 'Current' record in
' the forms recordset.
' vSearchDirection if provided should be an AcSearchDirection. If not provided, it is taken from the Parameter
' of the current CommandBarControl (assuming there is one).
'USAGE: call from a commandbar or macro. I bind this same function to two custom command bar items, each with a different
..Parameter value ("acUp" and "acDown")
'TODO:
' * support multiple format conditions (but, what is semantics of this? Should they be 'ORed' together?

On Error GoTo HandleErr

Dim SearchDirection As AcSearchDirection
Dim ExtendSelection As Boolean
Dim bm As Variant 'bookmark
Dim ac As Access.Control
Dim rs As DAO.Recordset
Dim fct As Access.AcFormatConditionType
Dim fco As Access.AcFormatConditionOperator
Dim fc As Access.FormatCondition
Dim fcs As Access.FormatConditions
Dim crit As String


If Not IsMissing(vSearchDirection) Then
SearchDirection = vSearchDirection
ElseIf CommandBars.ActionControl Is Nothing Then Err.Raise 666, , "cannot determine vSearchDirection in call to
cmdFindConditionallyFormatted"
Else
Select Case CommandBars.ActionControl.Parameter
Case "acDown"
SearchDirection = acDown
Case "acUp"
SearchDirection = acUp
Case Else
Err.Raise 666, , "invalid name of AcSearchDirection in CommandBars.ActionControl.Parameter:" &
CommandBars.ActionControl.Parameter
End Select
End If

Set ac = Access.Screen.ActiveControl

Set fcs = ac.FormatConditions
If fcs.Count = 0 Then Err.Raise 777, , ac.Controls(0).Caption & " has no Format Conditions by which to navigate. "
If fcs.Count <> 1 Then Err.Raise 777, , ac.Controls(0).Caption & " has multiple Format Conditions. Only a single format
condition placed on the current control for this to work"
Set fc = fcs(0)
fct = fc.type
Set rs = ac.Parent.Recordset
If fc.Enabled Then
Select Case fct
Case acExpression
crit = fc.Expression1
Case acFieldValue
Select Case fc.Operator
Case acEqual
crit = ac.ControlSource & " = " & fc.Expression1
Case acNotEqual
crit = ac.ControlSource & " <> " & fc.Expression1
Case acLessThan
crit = ac.ControlSource & " < " & fc.Expression1
Case acLessThanOrEqual
crit = ac.ControlSource & " <= " & fc.Expression1
Case acGreaterThan
crit = ac.ControlSource & " > " & fc.Expression1
Case acGreaterThanOrEqual
crit = ac.ControlSource & " >= " & fc.Expression1
Case acBetween
crit = ac.ControlSource & " >= " & fc.Expression1 & " AND " & ac.ControlSource & " <= " & fc.Expression2
Case acNotBetween
crit = ac.ControlSource & " < " & fc.Expression1 & " OR " & ac.ControlSource & " > " & fc.Expression2
Case Else
Err.Raise 666, , "unrecognized value for AcFormatConditionOperator: " & fc.Operator
End Select
Case acFieldHasFocus
Case Else
Err.Raise 666, , "unrecognized AcFormatConditionType: " & fct
End Select

bm = rs.Bookmark ' to which we will return if no record found.
Select Case SearchDirection
Case acDown
rs.FindNext (crit)
Case acUp
rs.FindPrevious (crit)
Case Else
Err.Raise 666, , "invalid AcSearchDirection: " & SearchDirection
End Select
If rs.NoMatch Then
Beep
rs.Bookmark = bm
End If
End If

ExitHere:
Exit Function

HandleErr:
Select Case Err.Number
Case 666 ' program logic error - shouldn't happen
MsgBox Err.Description
Stop
Case 777 'reportable condition - no problem, just report it to user
MsgBox Err.Description
Case Else 'unanticipated error. Write a new case!
MsgBox Err.Number & ":" & Err.Description
Debug.Assert False
End Select
Resume ExitHere

End Function