Dim Col11, Col12, Col13, Col14, Col15, Col16, Col17, Col18, Col19, Col20, Col21, Col22, Col23, Col24, Col25 As Long
Dim Col26, Col27, Col28, Col29, Col30, Col31, col32, Col33, Col34, ColBlank As Long
Col11 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 11")
Col12 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 12")
Col13 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 13")
Col14 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 14")
Col15 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 15")
Col16 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 16")
Col19 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 19")
Col20 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 20")
Col21 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 21")
Col22 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 22")
Col23 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 23")
Col24 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 24")
Col25 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 25")
Col26 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 26")
Col27 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 27")
Col28 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 28")
Col29 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 29")
Col30 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 30")
Col31 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 31")
col32 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 32")
Col33 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 33")
Col34 = DLookup("[ColourCode]", "Ref_DayType", "[ID] = 34")
ColBlank = 16777215
Dim i As Integer
Dim did As String
Dim dtop As String
Dim dbottom As String
For i = 1 To 31
did = "[" & "ID" & CStr(i) & "]"
dtop = "[" & "Day" & CStr(i) & "LabelTop]"
dbottom = "[" & "Day" & CStr(i) & "LabelBottom]"
Select Case Me(did)
Case 11
Me(dtop).BackColor = Col11
Me(dbottom).BackColor = Col11
Case 12
Me(dtop).BackColor = Col11
Me(dbottom).BackColor = ColBlank
Case 13
Me(dtop).BackColor = Col13
Me(dbottom).BackColor = Col13
Case 14
Me(dtop).BackColor = Col13
Me(dbottom).BackColor = ColBlank
Case 15
Me(dtop).BackColor = Col15
Me(dbottom).BackColor = Col15
Case 16
Me(dtop).BackColor = Col15
Me(dbottom).BackColor = ColBlank
Case 19
Me(dtop).BackColor = Col19
Me(dbottom).BackColor = Col19
Case 20
Me(dtop).BackColor = Col19
Me(dbottom).BackColor = ColBlank
Case 21
Me(dtop).BackColor = Col21
Me(dbottom).BackColor = Col21
Case 22
Me(dtop).BackColor = Col21
Me(dbottom).BackColor = ColBlank
Case 23
Me(dtop).BackColor = Col23
Me(dbottom).BackColor = Col23
Case 24
Me(dtop).BackColor = Col23
Me(dbottom).BackColor = ColBlank
Case 25
Me(dtop).BackColor = Col25
Me(dbottom).BackColor = Col25
Case 26
Me(dtop).BackColor = Col25
Me(dbottom).BackColor = ColBlank
Case 27
Me(dtop).BackColor = Col27
Me(dbottom).BackColor = Col27
Case 28
Me(dtop).BackColor = Col27
Me(dbottom).BackColor = ColBlank
Case 29
Me(dtop).BackColor = Col29
Me(dbottom).BackColor = Col29
Case 30
Me(dtop).BackColor = Col29
Me(dbottom).BackColor = ColBlank
Case 31
Me(dtop).BackColor = Col31
Me(dbottom).BackColor = Col31
Case 32
Me(dtop).BackColor = Col31
Me(dbottom).BackColor = ColBlank
Case 33
Me(dtop).BackColor = Col33
Me(dbottom).BackColor = Col33
Case 34
Me(dtop).BackColor = Col33
Me(dbottom).BackColor = Col33
Case Else
Me(dtop).BackColor = ColBlank
Me(dbottom).BackColor = ColBlank
End Select
Next i
Option Compare Database
Option Explicit
Public iColors As Object
Public Function SetColors()
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("SELECT * FROM Ref_DayType WHERE (ID BETWEEN 11 AND 34) AND ID Not In(17, 18) ORDER BY ID;")
Set iColors = CreateObject("Scripting.Dictionary")
Do While Not rst.EOF
iColors.Add CStr("col" & rst!ID), CLng(rst!ColorCode)
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
End Function
Public Function SetCtlColor(ctl As Control, intID As Long)
' ctl is the name of control to set backcolor of
' intID is the color ID
If iColors.Exists("col" & intID) Then
ctl.BackColor = CLng(iColors.Item("col" & intID))
Else
ctl.BackColor = 16777215
End If
End Function
Private Sub Form_Open(Cancel As Integer)
If iColors Is Nothing Then
Call SetColors
End If
End Sub
SetCtlColor Me.ControlName, Nz(Me.IDControlName.Value, 0)
I don't understand. It's a Date data type or a Double data type, not both. Date fields should have a data type of Date/Time.just out of interest do you know how to convert a type of field.
I have a date that is double or date (dim)
If you want to add n days to a Date/Time field, you can use the DateAdd() function (if this is what you're askingI need to take the date field (which is a number) and place into the for i = day to 31 so if I select day 5 it will then add up 5 to 31 under i.
Dim TotalHolCalc As Double, TotalSickCalc As Double, TotalELCalc As Double
TotalHolCalc = 0
TotalSickCalc = 0
TotalELCalc = 0
Dim SelectedDay As Double
SelectedDay = [Forms]![Main]![SubTotals]![CurrentMonth]
Dim d As String
Dim i As Integer
'For i = 1 To 31 <<< Original Line
For i = SelectedDay To 31
d = "[" & "Day" & CStr(i) & "]"
Select Case Me(d)
Case "H"
TotalHolCalc = CDbl(TotalHolCalc + 1)
Case "H½"
TotalHolCalc = CDbl(TotalHolCalc + 0.5)
Case "S"
TotalSickCalc = CDbl(TotalSickCalc + 1)
Case "S½"
TotalSickCalc = CDbl(TotalSickCalc + 0.5)
Case "EL"
TotalELCalc = CDbl(TotalELCalc + 1)
Case "EL½"
TotalELCalc = CDbl(TotalELCalc + 0.5)
Case "SH½"
TotalSickCalc = CDbl(TotalSickCalc + 0.5)
TotalELCalc = CDbl(TotalELCalc + 0.5)
Case "HS½"
TotalSickCalc = CDbl(TotalSickCalc + 0.5)
TotalELCalc = CDbl(TotalELCalc + 0.5)
End Select
Next i
TotalHoliday = CDbl(TotalHolCalc)
TotalSick = CDbl(TotalSickCalc)
TotalEL = CDbl(TotalELCalc)
SelectedDay = IsNull([Forms]![Main]![SubTotals]![CurrentMonth])
If IsNull([Forms]![Main]![SubTotals]![CurrentDay]) = True Then
SelectedDay = 1
Else
SelectedDay = [Forms]![Main]![SubTotals]![CurrentDay]
End If