Creating a 'calendar matrix' in Access

Question

I’m trying to create either a report or form that displays data in essentially a “calendar” form.

I have a course query that is (simplified) as “Course name”; “course days”; “course times”---

Course; Days; Times
PSY 1; MW; 8A-9A
SOC 150; M; 8A-11A
ANTH 2; Tu; 8A-9A
ANTH 199; MW; 8A-9A

In Access, I’m trying to create a form based on the query that would give me a matrix of the following:

• Columns: Times in hour increments
• Rows: Days of week

So, for example, with the above data, it would appear like this: Edit: Yargh, I can't submit an image unfortunately. So, here is a link to a "course schedule" that is essentially what I'm trying to do: Schedule

I have no idea where to start with this. Any tips (or links)?

Edit:

One idea I have is to create a form with a field for every possible cell in the matrix (so, for example, there would be one "Monday, 8-9A" field--and that field would be a filter on the query that ONLY displays results where "day" contains "M" and BeginTime or EndTime or between 8A and 9A). Unfortunately, I'm not sure how to do that.

Answer 1

You can do something close to what you seem to want as an Access form, but it's not easy. This screen capture displays your sample data in a Datasheet View form whose record source is an ADO disconnected recordset. It uses conditional formatting to set the text box background color when the text box value is not Null. Your picture suggested a different color for each Course, but I didn't want to deal with that when more than one Course can be scheduled in the same time block ... my way was simpler for me to cope with. :-)

The code to create and load the disconnected recordset is included below as GetRecordset(). The form's open event sets its recordset to GetRecordset().

Private Sub Form_Open(Cancel As Integer)
    Set Me.Recordset = GetRecordset
End Sub

Note I stored your sample data differently. Here is my Class_sessions table:

Course   day_of_week  start_time  end_time
------   -----------  ----------  -----------
PSY 1              2  8:00:00 AM   9:00:00 AM
PSY 1              4  8:00:00 AM   9:00:00 AM
SOC 150            2  8:00:00 AM  11:00:00 AM
ANTH 2             3  8:00:00 AM   9:00:00 AM
ANTH 199           2  8:00:00 AM   9:00:00 AM
ANTH 199           4  8:00:00 AM   9:00:00 AM

This is the function to create the disconnected recordset which is the critical piece for this approach. I developed this using early binding which requires a reference for "Microsoft ActiveX Data Objects [version] Library"; I used version 2.8. For production use, I would convert the code to use late binding and discard the reference. I left it as early binding so that you may use Intellisense to help you understand how it works.

Public Function GetRecordset() As Object
    Dim rsAdo As ADODB.Recordset
    Dim fld As ADODB.Field
    Dim db As DAO.Database
    Dim dteTime As Date
    Dim i As Long
    Dim qdf As DAO.QueryDef
    Dim rsDao As DAO.Recordset
    Dim strSql As String

Set rsAdo = New ADODB.Recordset
With rsAdo
    .Fields.Append "start_time", adDate, , adFldKeyColumn
    For i = 2 To 6
        .Fields.Append WeekdayName(i), adLongVarChar, -1, adFldMayBeNull
    Next
    .CursorType = adOpenKeyset
    .CursorLocation = adUseClient
    .LockType = adLockPessimistic
    .Open
End With

strSql = "PARAMETERS block_start DateTime;" & vbCrLf & _
    "SELECT day_of_week, Course, start_time, end_time" & vbCrLf & _
    "FROM Class_sessions" & vbCrLf & _
    "WHERE [block_start] BETWEEN start_time AND end_time" & vbCrLf & _
    "ORDER BY day_of_week, Course;"
Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, strSql)

dteTime = #7:00:00 AM#
Do While dteTime < #6:00:00 PM#
    'Debug.Print "Block start: " & dteTime
    rsAdo.AddNew
    rsAdo!start_time = dteTime
    rsAdo.Update

    qdf.Parameters("block_start") = dteTime
    Set rsDao = qdf.OpenRecordset(dbOpenSnapshot)
    Do While Not rsDao.EOF
        'Debug.Print WeekdayName(rsDao!day_of_week), rsDao!Course
        rsAdo.Fields(WeekdayName(rsDao!day_of_week)) = _
            rsAdo.Fields(WeekdayName(rsDao!day_of_week)) & _
            rsDao!Course & vbCrLf
        rsAdo.Update
        rsDao.MoveNext
    Loop

    dteTime = DateAdd("h", 1, dteTime)
Loop

rsDao.Close
Set rsDao = Nothing
qdf.Close
Set qdf = Nothing
Set GetRecordset = rsAdo
End Function