Add record to table with a background color

[rw22392]

Hi I have a series of records I want to add to a table and certain records that meet a criteria. I want to set a different background Color The code I am useing is as follows and I want to have a different background color on Team 31. The whole point is to create a shift schedule with two teams.



Public Function CreateWorkSchedule()
Dim Db As Database
Dim Rst As Recordset
Dim EndDate As Date
Dim ADate As Date
Dim Result As Long
Dim Counter As Long

Set Db = CurrentDb()
Set Rst = Db.OpenRecordset("Schedule&quot

Counter = 0
ADate = #8/4/02#
EndDate = #9/30/02#

Do

If Counter = 28 Then
Counter = 0
End If

Counter = Counter + 1
ADate = ADate + 1

Select Case Counter
Case 1
If Counter = 1 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Monday "
Rst!Team = " Team 31 "
Rst.Update
End If
Case 2
If Counter = 2 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Tuesday "
Rst!Team = " Team 31 "
Rst.Update
End If
Case 3
If Counter = 3 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Wednesday "
Rst!Team = " Team 31 "
Rst.Update
End If
Case 4
If Counter = 4 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Thursday "
Rst!Team = " Team 31 "
Rst.Update
End If
Case 5
If Counter = 5 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Friday "
Rst!Team = " Team 30 "
Rst.Update
End If
Case 6
If Counter = 6 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Saturday "
Rst!Team = " Team 30 "
Rst.Update
End If
Case 7
If Counter = 7 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Sunday "
Rst!Team = " Team 30 "
Rst.Update
End If
Case 8
If Counter = 8 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Monday "
Rst!Team = " Team 30 "
Rst.Update
End If
Case 9
If Counter = 9 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Tuesday "
Rst!Team = " Team 30 "
Rst.Update
End If
Case 10
If Counter = 10 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Wednesday "
Rst!Team = " Team 31 "
Rst.Update
End If
Case 11
If Counter = 11 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Thursday "
Rst!Team = " Team 31 "
Rst.Update
End If
Case 12
If Counter = 12 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Friday "
Rst!Team = " Team 31 "
Rst.Update
End If
Case 13
If Counter = 13 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Saturday "
Rst!Team = " Team 31 "
Rst.Update
End If
Case 14
If Counter = 14 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Sunday "
Rst!Team = " Team 31 "
Rst.Update
End If
Case 15
If Counter = 15 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Monday "
Rst!Team = " Team 30 "
Rst.Update
End If
Case 16
If Counter = 16 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Tuesday "
Rst!Team = " Team 30 "
Rst.Update
End If
Case 17
If Counter = 17 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Wednesday "
Rst!Team = " Team 30 "
Rst.Update
End If
Case 18
If Counter = 18 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Thursday "
Rst!Team = " Team 30 "
Rst.Update
End If
Case 19
If Counter = 19 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Friday "
Rst!Team = " Team 31 "
Rst.Update
End If
Case 20
If Counter = 20 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Saturday "
Rst!Team = " Team 31 "
Rst.Update
End If
Case 21
If Counter = 21 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Sunday "
Rst!Team = " Team 31 "
Rst.Update
End If
Case 22
If Counter = 22 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Monday "
Rst!Team = " Team 31 "
Rst.Update
End If
Case 23
If Counter = 23 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Tuesday "
Rst!Team = " Team 31 "
Rst.Update
End If
Case 24
If Counter = 24 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Wednesday "
Rst!Team = " Team 30 "
Rst.Update
End If
Case 25
If Counter = 25 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Thursday "
Rst!Team = " Team 30 "
Rst.Update
End If
Case 26
If Counter = 26 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Friday "
Rst!Team = " Team 30 "
Rst.Update
End If
Case 27
If Counter = 27 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Saturday "
Rst!Team = " Team 30 "
Rst.Update
End If
Case 28
If Counter = 28 Then
Rst.AddNew
Rst!Date = ADate
Rst!Day = " Sunday "
Rst!Team = " Team 30 "
Rst.Update
End If

End Select

Loop Until EndDate = ADate

End Function

 

[LittleSmudge]

First off

Inside your select statement the "If Counter = No Then" is doing absolutly nothing.
Because of the select statement each of the If.. .. Then statements will always be true - so is therefore a waste of time.

Secondly
There is absolutly NO POINT in setting the background colour of a record in a table. You can't see it, - no-one will ever know - so why do it ?

Do you mean you want to set the background colour on the FORM or REPORT as it is displayed ?


Thirdly
Simplify the Select statement to

rst.AddNew
rst!Date = ADate
rst!Day = " " & Format(ADate,"dddd&quot & " "

If Counter < 5 Then
Rst!Team = &quot; Team 31 &quot;
ElseIf Counter < 10 Then
Rst!Team = &quot; Team 30 &quot;
ElseIf Counter < 15 Then
Rst!Team = &quot; Team 31 &quot;
ElseIf Counter < 19 Then
Rst!Team = &quot; Team 30 &quot;
ElseIf Counter < 24
Rst!Team = &quot; Team 31 &quot;
Else
Rst!Team = &quot; Team 30 &quot;
EndIf
rst.Update


NOTE
The rst!Day field is a &quot;Calculated&quot; value and as such should NOT be stored in the table at all.



'ope-that-'elps.

G LS