Time based SLA KPI created using MS Access VBA

A client had a time based activity that had a start and end datetime . The client wanted to be able to calculate a service level agreement (SLA) metric based on the duration of time to complete the activity.

This SLA included requirement that time only be included in the metric if it was during work hours defined as 8am to 4pm excluding weekends and holidays. Holidays were identified by listing them manually in a database table (below).

The SLA metric was calculated for each activity as follows:

SLA Actual = End Datetime – Start Datetime in hours decimal value, excluding weekends, holidays and non-work hours.

This SLA metric really changed people’s view of the policy. Without specific data people’s perceptions of the time elapsed from start to end were wildly variant.

For example if an activity started at 3.55 PM on a Friday with a long weekend and was finished the following Tuesday at 10 AM it would only have 5 minutes time on Friday and 2 hours on Tuesday for total of 2 hours and 5 minutes or 2.083 hours. However before the SLA metric some perceived it elapsed SLA time as much as 5 days processing time. Using the SLA to analyse activity by people and department involved, activity category, etc was invaluable in identifying business process, training and communication issues and improvements.

The system used was an MS Access database.

The metric was to be calculated in and presented to user in an Access form so agents could see their real-time performance based on the SLA metric. The form had an auto refresh so the metric (and others) would be current.

The SLA metric also had to be calculated in MS Access queries to generate SLA metrics values for real-time and historical reporting and analysis purposes.

The function was included in required queries and an current SLA metric was created when the query was run, normally when a report was refreshed.

To enable both of these requirements a VBA function was created that could be called by both an Access form and Access query. The function VBA code is shown below.

The function output is a decimal value representing the number of hours. You can get an hour and minute value from the hour decimal by using modulo formula.

A challenge for using function in queries was that reports often included long time spans so potentially 100,000+ records could be included in query and as this function would run on each record it would be very slow. To address this the query function would only be applied to records that were more recent, with business rule assuming that older records would not have changing SLA eg they would be complete.

This VBA code and process can be reused for other similar purposes as long as you provide the function the required start and end datetime values (as parameters) and you use a holiday table which is a simple two column table (see below). You could modify the hard coded work day start and end hours to suit your business needs.

Option Compare Database
Option Explicit
'*** This is the code that is used to help calculate SLA actual hours.  The code calculates
'*** the net hours (total hours excluding weekends, holidays & hours outside of workday (8am-4pm)
'*** for the following:
'*** - net decision time (hours from IC Date/Time aka Application Received Date to Decision Date/Time)
'*** - net event time (for each event, hours from Start Date/Time to End Date/Time)
'*** The SLA actual hours = Net decision time - Sum(net event time) is calculated later
'*** in a set of queries.

Function NetHours(dteStart As Date, dteEnd As Date) As Single

    Dim GrossDays As Integer
    Dim WorkingDays As Integer
    Dim OneDayHours As Single

    Dim fixedEnd As Date
    Dim fixedStart As Date
    Dim dteStartEnd As Date
    Dim dteEndStart As Date

    Dim StartDayHours As Single
    Dim EndDayHours As Single

    Dim intCount As Integer
    Dim dteCurrDate As Date

    dteStartEnd = DateValue(dteStart) + TimeValue("4:00pm")
    dteEndStart = DateValue(dteEnd) + TimeValue("8:00am")

    'If dteStart or dteEnd before 8am, use 8 am, if after 4 pm use 4 pm otherwise use dteStart or dteEnd
        If dteStart > DateValue(dteStart) + TimeValue("8:00am") And dteStart <        DateValue(dteStart) + TimeValue("4:00pm") Then
            fixedStart = dteStart
            Select Case dteStart
            Case Is <= DateValue(dteStart) + TimeValue("8:00am")
                fixedStart = DateValue(dteStart) + TimeValue("8:00am")
            Case Is >= DateValue(dteStart) + TimeValue("4:00pm")
                fixedStart = DateValue(dteStart) + TimeValue("4:00pm")
            End Select
    End If

    If dteEnd > DateValue(dteEnd) + TimeValue("8:00am") And dteEnd < DateValue(dteEnd) + TimeValue("4:00pm") Then
        fixedEnd = dteEnd
        Select Case dteEnd
        Case Is <= DateValue(dteEnd) + TimeValue("8:00am")
            fixedEnd = DateValue(dteEnd) + TimeValue("8:00am")
        Case Is >= DateValue(dteEnd) + TimeValue("4:00pm")
            fixedEnd = DateValue(dteEnd) + TimeValue("4:00pm")
        End Select
    End If

    'Calculate hours on 1st day but check if they are weekends or holidays first
    'and if hours aren't within workday then assign hours
    StartDayHours = 0
    If Weekday(dteStart, vbMonday) <= 5 And IsNull(DLookup("[Holiday_Date]", "A_Holidays", _
    "[Holiday_Date] = " & Format(dteStart, "\#mm\/dd\/yyyy\#;;;\N\u\l\l"))) Then
        StartDayHours = (DateDiff("n", fixedStart, dteStartEnd)) / 60
        StartDayHours = 0
    End If

    'Calculate hours on last day but check if they are weekends or holidays first
    'and if hours aren't within workday then assign hours
    EndDayHours = 0
    If Weekday(dteEnd, vbMonday) <= 5 And IsNull(DLookup("[Holiday_Date]", "A_Holidays", _
    "[Holiday_Date] = " & Format(dteEnd, "\#mm\/dd\/yyyy\#;;;\N\u\l\l"))) Then
        EndDayHours = (DateDiff("n", dteEndStart, fixedEnd)) / 60
        EndDayHours = 0
    End If

    'Count workdays excluding weekends, holidays and first and last date
    WorkingDays = 0
    If DateDiff("d", dteStart, dteEnd) > 1 Then
        intCount = 0
        dteCurrDate = DateValue(dteStart)
        Do While dteCurrDate < DateValue(dteEnd)
            If Weekday(dteCurrDate, vbMonday) <= 5 And dteCurrDate <> DateValue(dteStart) And dteCurrDate <> DateValue(dteEnd) _
            And IsNull(DLookup("[Holiday_Date]", "A_Holidays", _
            "[Holiday_Date] = " & Format(dteCurrDate, "\#mm\/dd\/yyyy\#;;;\N\u\l\l"))) Then
                intCount = intCount + 1
                intCount = intCount
            End If
            dteCurrDate = dteCurrDate + 1
        WorkingDays = intCount
        WorkingDays = 0
    End If

    'Calculate gross # days between start and end
    GrossDays = 0
    GrossDays = DateDiff("d", dteStart, dteEnd)

    'Calculate hours between start and end times on same day
    OneDayHours = 0
    'If fixedStart < fixedEnd Then
    If Weekday(dteStart, vbMonday) <= 5 And IsNull(DLookup("[Holiday_Date]", "A_Holidays", _
    "[Holiday_Date] = " & Format(dteStart, "\#mm\/dd\/yyyy\#;;;\N\u\l\l"))) Then
        OneDayHours = (DateDiff("n", fixedStart, fixedEnd)) / 60
        OneDayHours = 0
    End If
    '    OneDayHours = 0
    'End If

    'Depending on # GrossDays then give final NetHours result
    NetHours = 0
    Select Case GrossDays
        Case 0
        'Start and end time on same day
            NetHours = OneDayHours
        Case 1
        'Start and end time on consecutive days
            NetHours = NetHours + StartDayHours
            NetHours = NetHours + EndDayHours
        Case Is > 1
        'Start and end time on non consecutive days
            NetHours = WorkingDays * 8
            NetHours = NetHours + EndDayHours
            NetHours = NetHours + StartDayHours
    End Select

End Function


The holidays table had these two columns, one for holiday date and another for the holiday name (which was not used by function just to identify the date).

Holiday_Date Holiday
01/01/2008 New Year’s Day
01/02/2008 Family Day (Markham)
21/03/2008 Good Friday
19/05/2008 Victoria Day
01/07/2008 Canada Day
04/08/2008 Civic Day
01/09/2008 Labour Day
13/10/2008 Thanksgiving Day
11/11/2008 Remembrance Day
25/12/2008 Christmas
26/12/2008 Boxing Day
01/01/2009 New Year’s Day
10/04/2009 Good Friday
18/05/2009 Victoria Day
01/07/2009 Canada Day
03/08/2009 Civic Holiday
07/09/2009 Labour Day
12/10/2009 Thanksgiving Day
11/11/2009 Remembrance Day
25/12/2009 Christmas
28/12/2009 Boxing Day lieu
01/01/2010 New Year’s Day
02/04/2010 Good Friday
24/05/2010 Victoria Day
01/07/2010 Canada Day
02/08/2010 Civic Holiday
06/09/2010 Labour Day
11/10/2010 Thanksgiving Day
11/11/2010 Remembrance Day
27/12/2010 Christmas Day lieu
28/12/2010 Boxing Day lieu
03/01/2011 New Year’s Day lieu
22/04/2011 Good Friday
23/05/2011 Victoria Day
01/07/2011 Canada Day
01/08/2011 Civic Holiday
05/09/2011 Labour Day
10/10/2011 Thanksgiving Day
11/11/2011 Remembrance Day
26/12/2011 Christmas Day lieu
27/12/2011 Boxing Day lieu

Leave a Comment

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.

Scroll to Top