Private Sub Form_Current()
'**Purpose: Populate the various text fields with dates relative to selection
Dim datFirst As Date
Dim datTemp As Date
Dim strDay As String
Dim strTemp As String
Dim intCount As Integer
Dim intCounter As Integer
Dim intDayCount As Integer
Dim ctl As Control
Dim intTemp As Integer
Dim strTemp2 As String
Dim datTemp2 As Date
Dim i As Long
Dim tmpText As String
Dim tmpText2 As String
Dim eventDate(10000) As Date
Dim eventID(10000) As String
Dim eventName(10000) As String
Dim eventWhat(10000) As String
Dim events As Long
Dim myset As Object
Dim Criteria As String
Dim condition As Integer
' Select Case Forms!frmScheduled!grpSort
' Case 1 'Name
' Me.GroupLevel(0).ControlSource = "ScheduleDate"
' Me.GroupLevel(1).ControlSource = "ID"
' End Select
'load events table data into array
events = 0
'Read in qry_Calendar to Array
Set myset = CurrentDb.OpenRecordset("SELECT tblSchedule.* FROM tblSchedule WHERE (((tblSchedule.ScheduleDate) Is Not Null)) ORDER BY tblSchedule.ScheduleDate, tblSchedule.ScheduleDate;", DB_OPEN_SNAPSHOT)
Criteria = "[ScheduleDate] <> Null"
myset.FindFirst Criteria
Do Until myset.NoMatch
events = events + 1
If IsNull(myset![id]) Then
eventDate(events) = myset![ScheduleDate]
eventID(events) = myset![id]
eventName(events) = myset![name]
eventWhat(events) = myset![What]
Else
For i = 1 To Int(DateDiff("d", myset![ScheduleDate], myset![ScheduleDate])) + 1
eventDate(events + i - 1) = DateAdd("d", i - 1, myset![ScheduleDate])
eventID(events + i - 1) = myset![id]
eventName(events) = myset![name]
eventWhat(events) = myset![What]
Next i
events = events + i - 1
End If
myset.FindNext Criteria
Loop
'Read in qry_Calendar2 to Array
Set myset = CurrentDb.OpenRecordset("SELECT tblSchedule.* FROM tblSchedule WHERE (((tblSchedule.ScheduleDate) Is Null) And ((tblSchedule.ScheduleDate) Is Not Null)) ORDER BY tblSchedule.ScheduleDate, tblSchedule.ScheduleDate;", DB_OPEN_SNAPSHOT)
Criteria = "[ScheduleDate] <> Null"
myset.FindFirst Criteria
Do Until myset.NoMatch
events = events + 1
eventDate(events) = myset![ScheduleDate]
eventID(events) = myset![id]
eventName(events) = myset![name]
eventWhat(events) = myset![What]
events = events + i - 1
myset.FindNext Criteria
Loop
'Clear all pre-existing fields
intCounter = 1
Do
Me("label" & intCounter).Caption = ""
Me("label" & intCounter).ControlTipText = ""
Me("label" & intCounter).ForeColor = 0
Me("label" & intCounter).Visible = False
Me("text" & intCounter).Caption = ""
Me("text" & intCounter).Visible = False
Me("text" & intCounter).BackColor = 16777215
Me("id" & intCounter).Caption = ""
intCounter = intCounter + 1
Loop Until intCounter = 38
'Set date
datFirst = strMonth & ". 1/" & intYear
'Find weekday of first day of month (integer format if possible)
strDay = Format(datFirst, "ddd")
'Set initial counter depending on day of week the corresponding month starts on
Select Case strDay
Case Is = "Mon"
intCounter = 1
Case Is = "Tue"
intCounter = 2
Case Is = "Wed"
intCounter = 3
Case Is = "Thu"
intCounter = 4
Case Is = "Fri"
intCounter = 5
Case Is = "Sat"
intCounter = 6
Case Is = "Sun"
intCounter = 7
End Select
'Find number of days in selected month by datediff from 1st day of next month in selected year
datTemp = DateAdd("m", 1, datFirst)
intDayCount = DateDiff("d", datFirst, datTemp)
'Populate calendar with date's
intCount = intCounter
strTemp = ""
Do
Me("label" & intCount).Caption = intCount - intCounter + 1
Me("label" & intCount).ControlTipText = strMonth & " " & intCount - intCounter + 1 & ", " & intYear
Me("label" & intCount).Visible = True
Me("text" & intCount).Visible = True
tmpText = ""
tmpText2 = ""
'Fixed Events
If intCount - intCounter + 1 = 25 And strMonth = "December" Then tmpText = Chr(13) + Chr(10) + "Christmas Day": Me("text" & intCount).BackColor = 16777215
If intCount - intCounter + 1 = 26 And strMonth = "December" Then tmpText = Chr(13) + Chr(10) + "Boxing Day": Me("text" & intCount).BackColor = 16777215
If intCount - intCounter + 1 = 1 And strMonth = "January" Then tmpText = Chr(13) + Chr(10) + "New Years Day": Me("text" & intCount).BackColor = 16777215
If intCount - intCounter + 1 = 15 And strMonth = "January" Then tmpText = Chr(13) + Chr(10) + "Martin Luther King's Day": Me("text" & intCount).BackColor = 16777215
If intCount - intCounter + 1 = 14 And strMonth = "February" Then tmpText = Chr(13) + Chr(10) + "Valentine's Day": Me("text" & intCount).BackColor = 16777215
If intCount - intCounter + 1 = 19 And strMonth = "February" Then tmpText = Chr(13) + Chr(10) + "President's Day": Me("text" & intCount).BackColor = 16777215
If intCount - intCounter + 1 = 20 And strMonth = "February" Then tmpText = Chr(13) + Chr(10) + "NO SCHOOL": Me("text" & intCount).BackColor = 16777215
If intCount - intCounter + 1 = 14 And strMonth = "March" Then tmpText = Chr(13) + Chr(10) + "NO SCHOOL": Me("text" & intCount).BackColor = 16777215
If intCount - intCounter + 1 = 28 And strMonth = "May" Then tmpText = Chr(13) + Chr(10) + "Memorial Day": Me("text" & intCount).BackColor = 16777215
If intCount - intCounter + 1 = 25 And strMonth = "December" Then tmpText = Chr(13) + Chr(10) + "Christmas Day": Me("text" & intCount).BackColor = 16777215
If intCount - intCounter + 1 = 26 And strMonth = "December" Then tmpText = Chr(13) + Chr(10) + "Boxing Day": Me("text" & intCount).BackColor = 16777215
If intCount - intCounter + 1 = 1 And strMonth = "January" Then tmpText = Chr(13) + Chr(10) + "New Years Day": Me("text" & intCount).BackColor = 16777215
If intCount - intCounter + 1 = 15 And strMonth = "January" Then tmpText = Chr(13) + Chr(10) + "Martin Luther King's Day": Me("text" & intCount).BackColor = 16777215
If intCount - intCounter + 1 = 14 And strMonth = "February" Then tmpText = Chr(13) + Chr(10) + "Valentine's Day": Me("text" & intCount).BackColor = 16777215
If intCount - intCounter + 1 = 19 And strMonth = "February" Then tmpText = Chr(13) + Chr(10) + "President's Day": Me("text" & intCount).BackColor = 16777215
If intCount - intCounter + 1 = 20 And strMonth = "February" Then tmpText = Chr(13) + Chr(10) + "NO SCHOOL": Me("text" & intCount).BackColor = 16777215
If intCount - intCounter + 1 = 14 And strMonth = "March" Then tmpText = Chr(13) + Chr(10) + "NO SCHOOL": Me("text" & intCount).BackColor = 16777215
If intCount - intCounter + 1 = 28 And strMonth = "May" Then tmpText = Chr(13) + Chr(10) + "Memorial Day": Me("text" & intCount).BackColor = 16777215
For i = 1 To events
If intCount - intCounter + 1 = Int(Format(eventDate(i), "d")) _
And strMonth = Format(eventDate(i), "mmmm") _
And intYear = Int(Format(eventDate(i), "yyyy")) _
Then
tmpText = tmpText + Chr(13) + Chr(10) + eventName(i)
tmpText2 = eventID(i) + " or [ID] = " + tmpText2
Me("text" & intCount).BackColor = 16777215 '16763080 14474460
End If
Next i
If Len(tmpText2) > 0 Then tmpText2 = Left(tmpText2, Len(tmpText2) - 11)
Me("text" & intCount).Caption = tmpText
Me("id" & intCount).Caption = tmpText2
If Int(Format(Date, "d")) = intCount - intCounter + 1 And strMonth = Format(Date, "mmmm") And intYear = Format(Date, "yyyy") Then
Me("text" & intCount).BackColor = 8454143 '16765650
End If
intCount = intCount + 1
strTemp = ""
Loop Until intCount = intCounter + intDayCount
End Sub