Employee schedules, 15 minutes interval table [working/slow; need alternative ideas]

[drex79]

Hello everyone,

Firstly, a big thanks to user and moderators as I have learned a large amount about vba through on this forum.

I have worked a great deal on a macro that (among other things) would count employee schedules (shift, breaks and lunch) on a 15 minutes interval. Everything works very well, however it isn't as fast as I would want it. When working with less than 50 employees, it is tolerable. For this example, however, I have stressed the file to 300 employees.

I will attempt to explain myself, please let me know if I need to clarify.





Layout

Schedule contains employee schedules (example for only 1 day below):

(table columns continues onward for Monday, Tuesday, etc.) (see attached template)

					Sunday	Sunday	Sunday	Sunday	Sunday	Sunday	Sunday
ID	First name	Last name	Location	Shift Status	Shift Start	Shift End	Break1	Lunch Start	Lunch End	Break2	Total Sched.
001	John	Doe	L1	x	09:00	17:00	10:30	12:30	13:00	15:00	8.00

Interval contains table to count of employees working in 15 minute intervals (example for only 1 day below):

(table rows continues onward for other intervals from midnight to midnight.) (see attached template)

	Shift	Shift	Shift	Shift	Shift	Shift	Shift
Interval	Sun	Mon	Tue	Wed	Thu	Fri	Sat
08:45	0	0	0	0	0	0	0
09:00	1	0	0	0	0	0	0
09:15	1	0	0	0	0	0	0
09:30	1	0	0	0	0	0	0
09:45	1	0	0	0	0	0	0
10:00	1	0	0	0	0	0	0
10:15	1	0	0	0	0	0	0
10:30	1	0	0	0	0	0	0

Break	Break	Break	Break	Break	Break	Break
Interval	Sun	Mon	Tue	Wed	Thu	Fri	Sat
08:45	0	0	0	0	0	0	0
09:00	0	0	0	0	0	0	0
09:15	0	0	0	0	0	0	0
09:30	0	0	0	0	0	0	0
09:45	0	0	0	0	0	0	0
10:00	0	0	0	0	0	0	0
10:15	0	0	0	0	0	0	0
10:30	1	0	0	0	0	0	0

Lunch	Lunch	Lunch	Lunch	Lunch	Lunch	Lunch
Interval	Sun	Mon	Tue	Wed	Thu	Fri	Sat
08:45	0	0	0	0	0	0	0
09:00	0	0	0	0	0	0	0
09:15	0	0	0	0	0	0	0
09:30	0	0	0	0	0	0	0
09:45	0	0	0	0	0	0	0
10:00	0	0	0	0	0	0	0
10:15	0	0	0	0	0	0	0
10:30	0	0	0	0	0	0	0

Method

Looping through all employees and all days, the time values are passed to a function which locations the start and end in the interval ranges (above) and add 1 to the value which is already in that cell.

Note that there is also a schedule code (x = Online) to only process Online employees as well as a separator code (L1 = Location1) to separate the count by (for example) location.


Macro

I re-wrote the macro using full word declarations to make it easier to understand.


Template

Attached


Problem / Solution

Instead of referring to cell values back and forth and adding 1 to the underlying value (super inefficient), I want to know if it's possible to use a set of arrays to perform this in memory first, then paste into the interval table once all of the employees/days have been looped through.



Also, if there are any tips for making this kind of script leaner, please feel free to tell me!

Thank you in advance to anyone willing to help me learn.

[SamT]

Very nice use of Variable name choices.

Personally, I would move the Variable Declarations to a module "Globals" and the code that initializes them to Sub InitializeVariables in the same module, then just call the init sub from the main sub, just to shorten the length of the main sub.

If you change the Select statements

      Worksheets("Schedule").Select
                    schedule_start_value = FormatDateTime(Cells(employee, schedule_start_start_position + (day * schedule_day_gap)), 4)

To With statements, it will speed up the code

     With  Worksheets("Schedule")
'Not dot before Cells
                    schedule_start_value = FormatDateTime(.Cells(employee, schedule_start_start_position + (day * schedule_day_gap)), 4)

Since you have to loop thru this so many times, it will bee even faster to use a variable for the Worksheet

Dim Schedule As Worksheet
Set Schedule  = Worksheets("Schedule").
      With Schedule
                    schedule_start_value = FormatDateTime(.Cells(employee, schedule_start_start_position + (day * schedule_day_gap)), 4)

Do the Same for the Interval sheet.

I cannot think of a single use for this kind of atomic detail. A full weeks schedule broken down into 15 minute intervals? I could see it for selected intervals. What will this be used for. if you are allowed to say.

[drex79]

Thanks SamT, I'll look into incorporating these changes!

Unfortunately, the use of this type of data is to staff based on interval requirements. I work in a call center and we receive a set number of bodies (or FTE) required to take a certain number of calls throughout the day in 15 minute intervals. So when scheduling agents to be online taking calls, we need to schedule them in order to conform to the requirements.

Makes you think twice when calling customer service

[drex79]

Anyone have any ideas it it would be possible to Loop through and update an array value instead of a cell?

There's a lot of back and forth; I'm sure it would be easier to updated on a virtual table instead of an actual table... I just don't know how...

[SamT]

Now far ahead do you have to schedule?
Is this just to check that your schedule meets the requirements?

[drex79]

Now far ahead do you have to schedule?
Is this just to check that your schedule meets the requirements?

Minimum 2 weeks out. But the template file is for a week at a time. This macro is just to count the employees during the time they would be on their given shift, breaks, and lunch.

There are other aspects, but in its simplest form, it plots their time on a granular table in order to plan the staff would cover requirements.

[Paul_Hossler]

Couple of suggestions to consider

1. Create 3 module level variables and Set them at the beginning

Option Explicit
Dim wsSettings As Worksheet, wsSchedule As Worksheet, wsInterval As Worksheet

......

Public Sub generate_interval_report()
........

Set wsSettings = Worksheets("Settings")
Set wsSchedule = Worksheets("Schedule")
Set wsInterval = Worksheets("Interval")

2. Use With / End With to make it easier to see (same reason I personally don't like multiple statements on one line with a ":" )

With wsSettings
    employee_start_position = .Range("employee_start_position")

..........


    Set separator_code_range = .Range("separator_code_range")
End With

3. I noticed that there was a lot .Select-ing and re-Selecting in the main loop. You usually don't have to Select a WS or Cell to act on or with it. Look at my -------------------- markers

With wsSchedule             '   no .Select --------------------
For employee = employee_start_position To employee_end_position
    For day = 0 To 6
        '-------------------- dot Cells to go with wsSchedule
        schedule_code_value = .Cells(employee, schedule_code_start_position + (day * schedule_day_gap))
        If Application.WorksheetFunction.CountIf(schedule_code_range, schedule_code_value) > 0 Then
            schedule_code_group_value = schedule_code_range.Find(What:=schedule_code_value, LookIn:=xlValues, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False).Offset(0, 1)
            If schedule_code_group_value = "Online" Then
                employee_separator_value = .Cells(employee, employee_separator_position).Text
                If WorksheetFunction.CountIf(separator_code_range, employee_separator_value) > 0 Then
                    interval_separator_unique_position = separator_code_range.Find(What:=employee_separator_value, LookIn:=xlValues, LookAt:= _
                    xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False).Offset(0, 2)
                    'pull time values
                    '-------------------------------Worksheets("Schedule").Select
                    schedule_start_value = FormatDateTime(.Cells(employee, schedule_start_start_position + (day * schedule_day_gap)), 4)
                    schedule_break1_value = FormatDateTime(.Cells(employee, schedule_break1_start_position + (day * schedule_day_gap)), 4)
                    schedule_lunch_start_value = FormatDateTime(.Cells(employee, schedule_lunch_start_start_position + (day * schedule_day_gap)), 4)
                    schedule_lunch_end_value = FormatDateTime(.Cells(employee, schedule_lunch_end_start_position + (day * schedule_day_gap)), 4)
                    schedule_break2_value = FormatDateTime(.Cells(employee, schedule_break2_start_position + (day * schedule_day_gap)), 4)
                    schedule_end_value = FormatDateTime(.Cells(employee, schedule_end_start_position + (day * schedule_day_gap)), 4)
                    If IsEmpty(schedule_lunch_end_value) Then
                            schedule_lunch_end_value = FormatDateTime(DateAdd("n", 30, schedule_lunch_start_value), 4)
                    End If
                    
                    'shift
                    '---------------------Worksheets("Interval").Select
                    interval_start_index = getRowByString(schedule_start_value)
                    interval_end_index = getRowByString(schedule_end_value)
                    'fix midnight position; derp
                    If interval_start_index = 100 Then
                        interval_start_index = 4
                    ElseIf interval_end_index = 4 Then
                        interval_end_index = 100
                    End If
                    For interval = (interval_start_index + interval_separator_unique_position - interval_separator_combined_position) To ((interval_end_index - 1) + interval_separator_unique_position - interval_separator_combined_position)
                        '---------------------------
                        wsInterval.Cells(interval, interval_shift_start_position + 1 + (day * interval_day_gap)).Value = wsInterval.Cells(interval, interval_shift_start_position + 1 + (day * interval_day_gap)).Value + 1
                    Next interval
                    
                    'break1
                    If Not schedule_break1_value = "00:00" Then
                        interval_start_index = getRowByString(schedule_break1_value) + interval_separator_unique_position - interval_separator_combined_position
                        wsInterval.Cells(interval_start_index, interval_break_start_position + 1 + (day * interval_day_gap)).Value = wsInterval.Cells(interval_start_index, interval_break_start_position + 1 + (day * interval_day_gap)).Value + 1
                    End If
                    
                    'break2
                    If Not schedule_break2_value = "00:00" Then
                        interval_start_index = getRowByString(schedule_break2_value) + interval_separator_unique_position - interval_separator_combined_position
                        wsInterval.Cells(interval_start_index, interval_break_start_position + 1 + (day * interval_day_gap)).Value = wsInterval.Cells(interval_start_index, interval_break_start_position + 1 + (day * interval_day_gap)).Value + 1
                    End If
                    
                    'lunch
                    If Not schedule_lunch_start_value = "00:00" Or Not schedule_lunch_end_value = "00:00" Then
                        interval_start_index = getRowByString(schedule_lunch_start_value)
                        interval_end_index = getRowByString(schedule_lunch_end_value)
                        For interval = (interval_start_index + interval_separator_unique_position - interval_separator_combined_position) To ((interval_end_index - 1) + interval_separator_unique_position - interval_separator_combined_position)
                            wsInterval.Cells(interval, interval_lunch_start_position + 1 + (day * interval_day_gap)).Value = wsInterval.Cells(interval, interval_lunch_start_position + 1 + (day * interval_day_gap)).Value + 1
                        Next interval
                    End If
                    interval_separator_unique_position = vbNullString
                End If
            End If
        End If
        '   ---------------------------------------Worksheets("Schedule").Select
    Next day
Next employee
End With        '------------------------------------------------
With Application
    .Calculation = xlCalculationAutomatic: .ScreenUpdating = True: .DisplayStatusBar = True: .EnableEvents = True
End With
Worksheets("Schedule").Select       '   -------------------------------- Activate
Exit Sub
Errorcatcher:
MsgBox ("Something went wrong;" & vbNewLine & vbNewLine & Err.Description)
Resume Next
End Sub
Function getRowByString(ByVal thisHour As String)
Dim row_number As String
    
    '----------------------------    Worksheets("Interval").Select
    '-----------------------------   wsInterval.Range("interval_range").Select
    wsInterval.Range("interval_range").Find(What:=thisHour, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False).Activate
    row_number = ActiveCell.Row
    getRowByString = row_number
End Function

[drex79]

Thanks you, Paul!

I'll make sure to watch out for selecting in the loop and optimize the With beforehand.

I appreciate your insight!

[drex79]

Just one question Paul;

Wouldn't I need to declare wsInterval in the function as well?

[Paul_Hossler]

The 3 WS are declared at the module level, so they are in scope for any function or sub in that module

Option Explicit 

Dim wsSettings As Worksheet, wsSchedule As Worksheet, wsInterval As Worksheet

If they had been Public then they would have been in scope for all modules

Option Explicit 

Public wsSettings As Worksheet, wsSchedule As Worksheet, wsInterval As Worksheet

[drex79]

Yup, that would make sense. You're awesome Paul, thanks again!