The two procedures you would need to modify to get your data are fGetArray and DateArry.
fGetArray gets a recordset of the distinct dates from your table in the selected month where there is a record for that day.
It then loops through that recordset and adds the date as the key value of a scripting dictionary and for each date calls the DateArry function which concatenates the records for that date and adds them as the Item value of the dictionary.
Then I iterate through the 42 textboxes on the form (note that the controls tag contains the date) and if the date exists in the dictionary it writes the dictionary item value to that textbox.
The ClickBox function just opens a form which is filtered to the date in the textboxes tag property.
Hope this makes sense.
Code:
Public Sub fGetArray()
On Error GoTo fGetArray_Error
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strsql As String, EndDate As Date, strKey As Variant
Dim strItem As String, i As Integer, ctlK As Variant
Set dict = New Scripting.Dictionary
EndDate = DateAdd("d", 42, FirstDateOnGrid)
strsql = "select Distinct dteDate from tblEvents where dteDate between #" & FirstDateOnGrid & "# and #" & EndDate & "# order by dteDate"
Set db = CurrentDb()
Set rs = db.OpenRecordset(strsql)
If rs.BOF And rs.EOF Then
GoTo MyExit
End If
Do Until rs.EOF
strKey = rs!dteDate
strItem = DateArry(rs!dteDate)
dict.Add strKey, CStr(strItem)
rs.MoveNext
Loop
For i = 1 To 42
ctlK = CDate(Forms("frmMainCalendar").Controls("Bx" & i).Tag)
If dict.Exists(ctlK) Then
Forms("frmMainCalendar").Controls("Bx" & i).Value = dict.Item(ctlK)
End If
Next i
Set dict = Nothing
Me.btoUp.SetFocus
MyExit:
rs.Close
Set rs = Nothing
Set db = Nothing
On Error GoTo 0
Exit Sub
fGetArray_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure fGetArray, line " & Erl & "."
End Sub
Function DateArry(dte As Date) As String
On Error GoTo DateArry_Error
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strsql As String, strOut As String
strsql = "select * from tblEvents where dteDate = #" & dte & "# order by tmeTime"
Set db = CurrentDb()
Set rs = db.OpenRecordset(strsql)
If rs.BOF And rs.EOF Then
GoTo MyExit
'MsgBox 0
End If
Do Until rs.EOF
strOut = strOut & (Format(rs!tmeTime, "h:nnAMPM") + " ") & rs!EventDescription & vbNewLine
rs.MoveNext
Loop
DateArry = strOut
MyExit:
rs.Close
Set rs = Nothing
Set db = Nothing
On Error GoTo 0
Exit Function
DateArry_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure DateArry, line " & Erl & "."
End Function