Access DBMS

18 Easy Steps: Scheduling/Calendar in MS Access

This is a simple database that allows the visualization of employee schedules, employing Schedules, Rotations, and Assignments.

Main Form

The basic data schema is:

  1. Schedule Templates define for each weekday (Monday through Friday), the Work Code (e.g. Working, Break, Lunch, Meeting) for each time during the day, using a Start and End time. For example:
    Schedule Template - Table
    Schedule Templates – Table View
    Schedule Template - Form
    Schedule Templates – Form View

     

     

  2. Rotations define the rotation of schedules to which employees are assigned, and include the schedule template for each rotation week. For example:
    Rotations - Form
    Rotations – Form View

    Rotations - Table
    Rotations – Table View
  3. Employees are then assigned to Rotations with and Effective Date and Rotation Start Week. For example:
    Assignments - Table
    Assignments – Table View

    Assignments - Form
    Assignments – Form View
  4. The Assignment form needs specific data validation because the Rotation Start Week must be one of the weeks in the Rotations table for the choose rotation. Validation looks like:
    1. Function DataValidationIsOkay() As Boolean
      Dim rst As New ADODB.Recordset
      Dim strSQL As String

      strSQL = “SELECT IIf(” & Me!AssignStartWeek & ” In (SELECT RotWeek FROM tbl_RotationDetails),-1,0) AS Result ” & _
      “FROM tbl_Rotations INNER JOIN tbl_RotationDetails ON tbl_Rotations.RotID = tbl_RotationDetails.RotNumber ” & _
      “WHERE tbl_Rotations.RotID= ” & Me!AssignRotNumber

      rst.Open strSQL, CurrentProject.Connection, adOpenStatic, adLockPessimistic

      If Not rst.EOF Then

      rst.MoveFirst

      If rst(0) = 0 Then
      MsgBox “Rotation Start Week is not valid. Please enter a valid Rotation Start Week and try again.”, vbOKOnly, “Data Validation Failed”

      DataValidationIsOkay = False
      Else
      DataValidationIsOkay = True
      End If
      Else
      DataValidationIsOkay = False
      End If

      rst.Close
      Set rst = Nothing

      End Function

  5. Employees is a standard table/form:
    Employees - Table
    Employees – Table View

    Employees - Form
    Employees – Form View
  6. Now for the fun stuff! What we’re looking for is a color-coded schedule visualization, something like:

    Schedule Visualization Example Excel
    Visualization Mockup (in Excel)
  7. Unfortunately we cannot embed the above into an Access form and control it with VBA, so we’re stuck using an ActiveX control, specifically Microsoft Office Spreadsheet 11.0, which has enough of the functionality we want to give us the desired result:

    Office Spreadsheet 11.0
    Spreadsheet 11.0 ActiveX Control
  8. We’re going to populate this ActiveX control dynamically for a given date. The main form looks like this, and defaults to today’s date (we’ll also add in Leader and Staff filters later):

    Main Form
    Main Form
  9. To create this visualization take two somewhat complicated steps:
    1. Based on Employee Assignments, generate a list of Work Codes for each 15 minute block defined by the schedule. This list will be used for color-coding. The output we want is:

      TEMP Employee Schedule Data.PNG
      Employee Schedule Data
    2. Populate the ActiveX control.
  10. Let’s start with dynamically generating the Employee Schedule data first. The data is created from the Assignments table, so first we look at that. We need to increment through this table since each Employee may have a different Effective Date and Rotation Start Week:

    Assignments - Table
    Assignments
  11. We need to then determine what Rotation week we’re in, based on the Effective Date and Rotation Start Week. This is done with two functions, one to determine the maximum number of weeks in a Rotation, and the other to determine which Rotation week a given date is in:
    1. Function GetRotWeek(RotID As Long, dSchedDate As Date, intStartWeek As Integer, dAssignEffDate As Date) As Integer
      Dim lRotWeeks As Long

      lRotWeeks = GetNumRotWeeks(RotID)

      GetRotWeek = intStartWeek + (DatePart(“ww”, dSchedDate) – DatePart(“ww”, dAssignEffDate))

      If GetRotWeek > lRotWeeks Then
      Do Until GetRotWeek <= lRotWeeks
      GetRotWeek = GetRotWeek – lRotWeeks
      Loop
      End If

      End Function

      Function GetNumRotWeeks(intRot As Long) As Long
      Dim strSQL As String
      Dim rst As New ADODB.Recordset

      strSQL = “SELECT Max(tbl_RotationDetails.RotWeek) AS MaxOfRotWeek ” & _
      “FROM tbl_Rotations INNER JOIN tbl_RotationDetails ON tbl_Rotations.RotID = tbl_RotationDetails.RotNumber ” & _
      “GROUP BY tbl_Rotations.RotID ” & _
      “HAVING tbl_Rotations.RotID=” & intRot

      rst.Open strSQL, CurrentProject.Connection, adOpenStatic, adLockPessimistic
      rst.MoveFirst

      GetNumRotWeeks = rst!MaxOfRotWeek

      rst.Close
      Set rst = Nothing

      End Function

  12. Then we run a query to generate each row and append it to our temporary table. The query looks like:

    Query to Generate Employee Schedules
    Query to Generate Employee Schedules
  13. The full routine looks like:
    1. Sub CreateEmpSchedules()
      ‘— subroutine to populate tbl_TEMP_EmpSchedules —‘

      Dim rst As New ADODB.Recordset
      Dim rstAssignments As New ADODB.Recordset
      Dim strSQL As String
      Dim dSchedTime As Date

      strSQL = “DELETE * FROM tbl_TEMP_EmpSchedules”

      DoCmd.SetWarnings False
      DoCmd.RunSQL strSQL
      DoCmd.SetWarnings True

      rstAssignments.Open “tbl_Assignments”, CurrentProject.Connection, adOpenStatic, adLockPessimistic
      rstAssignments.MoveFirst

      Do Until rstAssignments.EOF

      strSQL = “SELECT tbl_Assignments.AssignEmpNumber, tbl_WorkCodes.WorkCodeID, tbl_ScheduleTemplateDetails.TimeStart, tbl_ScheduleTemplateDetails.TimeEnd ” & _
      “FROM ((tbl_ScheduleTemplates INNER JOIN ((tbl_Rotations INNER JOIN (tbl_Employees INNER JOIN tbl_Assignments ON tbl_Employees.EmpID = tbl_Assignments.AssignEmpNumber) ON tbl_Rotations.RotID = tbl_Assignments.AssignRotNumber) INNER JOIN tbl_RotationDetails ON tbl_Rotations.RotID = tbl_RotationDetails.RotNumber) ON tbl_ScheduleTemplates.SchedTempID = tbl_RotationDetails.RotSchedTempNumber) INNER JOIN (tbl_Weekdays INNER JOIN tbl_ScheduleTemplateDetails ON tbl_Weekdays.WeekdayID = tbl_ScheduleTemplateDetails.SchedTempWeekdayNumber) ON tbl_ScheduleTemplates.SchedTempID = tbl_ScheduleTemplateDetails.SchedTempNumber) INNER JOIN tbl_WorkCodes ON tbl_ScheduleTemplateDetails.SchedTempWorkCodeNumber = tbl_WorkCodes.WorkCodeID ” & _
      “WHERE tbl_RotationDetails.RotWeek = ” & GetRotWeek(rstAssignments!AssignRotNumber, [Forms]![frm_main]![SelectionBeginDate], rstAssignments!AssignStartWeek, rstAssignments!AssignEffDate) & ” ” & _
      “AND tbl_Assignments.AssignEmpNumber = ” & rstAssignments(1) & ” ” & _
      “AND tbl_Weekdays.WeekdayNumber=” & Weekday([Forms]![frm_main]![SelectionBeginDate], 2) & ” ”

      rst.Open strSQL, CurrentProject.Connection, adOpenStatic, adLockPessimistic

      If rst.EOF Then

      Else
      rst.MoveFirst

      Do Until rst.EOF
      dSchedTime = rst!TimeStart

      Do Until dSchedTime >= rst!TimeEnd

      strSQL = “INSERT INTO tbl_TEMP_EmpSchedules (EmpNumber, EmpSchedDate, EmpSchedCodeNumber) ” & _
      “VALUES (” & rst!AssignEmpNumber & “, #” & dSchedTime & “#, ” & rst!WorkCodeID & “)”

      DoCmd.SetWarnings False
      DoCmd.RunSQL strSQL
      DoCmd.SetWarnings True

      dSchedTime = DateAdd(“n”, 15, dSchedTime)
      Loop

      rst.MoveNext
      Loop

      End If

      rst.Close
      Set rst = Nothing

      rstAssignments.MoveNext
      Loop

      rstAssignments.Close
      Set rstAssignments = Nothing

      End Sub

  14. Okay, no that we have the data, we just need to visualize it. That is done by manipulating the spreadsheet ActiveX Control. The format lends itself to a crosstab query, so I start with that. It looks like:

    Schedule Visualization Crosstab Query
    Schedule Visualization Crosstab Query
  15. The query procedures results like this, which are translated to color coding in the VBA:

    Schedule Visualization Crosstab Query Results.PNG
    Schedule Visualization Crosstab Query Results
  16. Some simple VBA for filling in the cells and color coding and you’re done!
    1. Sub UpdateSchedule()
      Dim rst As New ADODB.Recordset
      Dim strSQL As String
      Dim strSQLStart As String
      Dim strSQLEnd As String
      Dim x, y As Integer

      Call CreateEmpSchedules

      strSQLStart = “TRANSFORM First(tbl_TEMP_EmpSchedules.EmpSchedCodeNumber) AS FirstOfEmpSchedCodeNumber ” & _
      “SELECT tbl_TEMP_EmpSchedules.EmpNumber, tbl_Employees.EmpLeaderNumber ” & _
      “FROM tbl_Employees INNER JOIN tbl_TEMP_EmpSchedules ON tbl_Employees.EmpID = tbl_TEMP_EmpSchedules.EmpNumber ” & _
      “WHERE 1=1 ”

      strSQLEnd = “GROUP BY tbl_TEMP_EmpSchedules.EmpNumber, tbl_Employees.EmpLeaderNumber ” & _
      “PIVOT tbl_TEMP_EmpSchedules.EmpSchedDate ”

      strSQL = strSQLStart & ” ” & strSQLEnd

      rst.Open strSQL, CurrentProject.Connection, adOpenStatic, adLockPessimistic

      If rst.EOF Then
      MsgBox “No current schedules for the given filter(s)”, vbOKOnly, “No Results”
      Exit Sub
      End If

      rst.MoveFirst

      y = 2 ‘ row 2

      Me!SheetSchedule.ActiveSheet.Unprotect

      Do Until rst.EOF

      x = 1 ‘ column 1

      Me!SheetSchedule.Cells(y, x) = DLookup(“[EmpFName]”, “tbl_Employees”, “EmpID=” & rst(0)) & ” ” & DLookup(“[EmpLName]”, “tbl_Employees”, “EmpID=” & rst(0))
      Me!SheetSchedule.Cells(y, x + 1) = DLookup(“[EmpFName]”, “tbl_Employees”, “EmpID=” & rst(1)) & ” ” & DLookup(“[EmpLName]”, “tbl_Employees”, “EmpID=” & rst(1))

      Do Until x + 2 = 37
      Me!SheetSchedule.Cells(1, x + 2) = rst(x + 2).Name

      Select Case rst(x + 2)
      Case Is = 1 ‘ ACDCharity1
      Me!SheetSchedule.Cells(y, x + 2).Interior.ColorIndex = 50
      Case Is = 2 ‘ Break
      Me!SheetSchedule.Cells(y, x + 2).Interior.ColorIndex = 55
      Case Is = 3 ‘ Coaching
      Me!SheetSchedule.Cells(y, x + 2).Interior.ColorIndex = 36
      Case Is = 4 ‘ Lunch
      Me!SheetSchedule.Cells(y, x + 2).Interior.ColorIndex = 40
      Case Else
      Me!SheetSchedule.Cells(y, x + 2).Interior.ColorIndex = 2
      End Select

      x = x + 1
      Loop

      y = y + 1
      rst.MoveNext
      Loop

      rst.Close
      Set rst = Nothing

      Me!SheetSchedule.ActiveSheet.Protect

      End Sub

  17. You may have noticed the curious WHERE 1=1 clause in the crosstab query. That’s for adding filtering by Employees and Leaders later. Let me know if you want details in the comments below!
  18. So that’s it. If you want a complete copy of the database for free, just email me: michael@dikuw.com and I’ll gladly share.
Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s