Option Compare Database
Option Explicit
Public Function fncColorize(ByRef ctl As TextBox)
'*
'* arnelgp
'*
'*NOTE:
'*
'* there is limit to the number of FormatConditions you can set.
'* some say its limited between 32 to 50
'*
'* so if you have more than 32 distinct Registration, this will fail.
'*
'*
'* create as many color if you have manny different Registration
'* or you can recycle the color every four registration
Const LIMITS As Integer = 32
Dim arrcolor
Dim colCondition As Collection
Dim bolNew As Boolean
Dim i As Integer, j As Integer
'* three colors at the moment but you can add more
arrcolor = Array(11957550, 3243501, 49407)
'* delete all format conditions
ctl.FormatConditions.Delete
'* new collection
Set colCondition = New Collection
i = 1
bolNew = True
'* open recordset
With CurrentDb.OpenRecordset( _
"SELECT DISTINCT Registration From tblRegistration ORDER By Registration ASC;", _
dbOpenSnapshot)
If Not (.BOF And .EOF) Then .MoveFirst
On Error Resume Next
While Not .EOF
'* limit the conditions to 32
'* so on the 33 records, the color will go back to color 1 of the array
If i > LIMITS Then
i = 1
bolNew = False
End If
If bolNew Then
colCondition.Add !Registration & "/", i & ""
Else
colCondition.Item(i) = colCondition.Item(i) & !Registration & "/"
End If
i = i + 1
.MoveNext
Wend
End With
j = 0
For i = 1 To colCondition.Count
'* add the FormatCondition with background color
With ctl.FormatConditions.Add(AcFormatConditionType.acExpression, _
acEqual, _
"Instr(""" & colCondition.Item(i) & """,[Registration])>0")
.BackColor = arrcolor(j)
End With
j = j + 1
If j > UBound(arrcolor) Then j = 0
Next i
Set colCondition = Nothing
End Function
