Employee Availability Problem

[Bombaygin]

Hello,

I am hoping for some help. I have to create a table that shows how many employees are available to work during each hour of the day for each day of the week. My problem is I have no idea what approach to take or formulas to usez to get that information from my export of data with 5000+ rows on the availability of 900+ employees. Availability times are exported like below with some employees having three windows of availability on the same day in the same cell. I would like to find a way to display this availability like the below table. It would then be used to graph against customer demand per hour. Any suggestion would greatly be appreciated.

Employee	Monday	Tuesday	Wednesday
Steve	8:00-13:00;18:00-23:00	13:00-23:00	8:00-12:00;13:00-16:00;18:00-22:00
Fred	10:00-18:00	10:00-18:00	11:00-19:00
Mike	7:00-15:00	7:00-15:00; 17:00:19:00	N/A

<tbody>
</tbody>

Time	Monday	Tuesday	Wednesday
7:00	1	1
8:00	2	1	1
9:00	2	1	1
10:00	3	2	1
11:00	3	2	2

<tbody>
</tbody>

 

[Peter_SSs]

Test in a copy of your workbook.

Assumptions (advise if any are incorrect or cannot be arranged)
- A Summary sheet for the results exists and has column A and row 1 similar to the first screen shot below.
- Any other data that may already be on the Summary sheet (apart from column A & row 1) can be deleted.
- The string in your sample for Mike on Tuesday ("17:00:19:00") is a typo and should have been "17:00-19:00"
- All availability blocks on the 'Data' sheet start and end on a whole hour (xx:00) like all your samples.

Excel Workbook
	A	B	C	D	E	F
1	Time	Mon	Tue	Wed	Thu	Fri
2	0:00
3	1:00
4	2:00
5	3:00
6	4:00
7	5:00
8	6:00
9	7:00
10	8:00
11	9:00
12	10:00
13	11:00
14	12:00
15	13:00
16	14:00
17	15:00
18	16:00
19	17:00
20	18:00
21	19:00
22	20:00
23	21:00
24	22:00
25	23:00
Summary

Sub Availability()
  Dim a, b, Blocks, StartStop
  Dim r As Long, c As Long, i As Long, j As Long, ub2 As Long
  
  a = Sheets("Data").Range("A1").CurrentRegion.Value    '<-Check sheet name
  ub2 = UBound(a, 2)
  ReDim b(1 To 24, 1 To ub2 - 1)
  For r = 2 To UBound(a)
    For c = 2 To ub2
      Blocks = Split(Replace(a(r, c), " ", ""), ";")
        For i = 0 To UBound(Blocks)
          StartStop = Split(Blocks(i), "-")
          If UBound(StartStop) > 0 Then
            For j = Val(StartStop(0)) To Val(StartStop(1)) - 1
              b(j + 1, c - 1) = b(j + 1, c - 1) + 1
            Next j
          End If
        Next i
    Next c
  Next r
  With Sheets("Summary").UsedRange.Offset(1, 1)         '<-Check sheet name
    .ClearContents
    .Resize(UBound(b, 1), UBound(b, 2)).Value = b
  End With
End Sub

Sample Data:

Excel Workbook
	A	B	C	D
1	Employee	Monday	Tuesday	Wednesday
2	Steve	8:00-13:00;18:00-23:00	13:00-23:00	8:00-12:00;13:00-16:00;18:00-22:00
3	Fred	10:00-18:00	10:00-18:00	11:00-19:00
4	Mike	7:00-15:00	7:00-15:00; 17:00-19:00	N/A
Data

Summary sheet after code:

Excel Workbook
	A	B	C	D
1	Time	Mon	Tue	Wed
2	0:00
3	1:00
4	2:00
5	3:00
6	4:00
7	5:00
8	6:00
9	7:00	1	1
10	8:00	2	1	1
11	9:00	2	1	1
12	10:00	3	2	1
13	11:00	3	2	2
14	12:00	3	2	1
15	13:00	2	3	2
16	14:00	2	3	2
17	15:00	1	2	2
18	16:00	1	2	1
19	17:00	1	3	1
20	18:00	1	2	2
21	19:00	1	1	1
22	20:00	1	1	1
23	21:00	1	1	1
24	22:00	1	1
25	23:00
Summary

 

[Bombaygin]

Hi Peter, I greatly appreciate your help. I have next to no experience with VBA and did not give thought to it as a solution for my problem. So I gave a dumb-down example of my export data. Your macro works perfect with this, but not with my actual export data. Unfortunately, with next to zero knowledge of VBA I am unable to adapt your work. Are you able to still help? A snap shot of the actual export is below.
Thanks

[/URL][/IMG]

 

[Peter_SSs]

1. Unfortunately, a picture is not a lot of use as I cannot copy the data from a picture to my worksheet to test - & I'm not intending to manually type that much out.
My signature block below has suggestions for how to post small screen shots directly in your post as I did above. Then the data can be copied to a worksheet to test.
You don't need to post the whole worksheet, a section similar to the image you provided should probably do, though a description about how extensive the sheet actually is would be useful. Make sure you disguise any sensitive or personal information before posting it.

2. You didn't confirm anything about a Summary sheet. Does it exist, what does it look like?

3. You haven't said what to do in the summary if an employee is only available for half an hour (or possibly only 5 minutes) of a one-hour block, like in cell E17 of your image. Does the summary actually consist of one hour blocks or something else?

Remember, we are not familiar with your workbook so have to rely on what you tell and show us about it. The better we understand what you have and what you need, the more likely you are to get a good result and the less likely we are to be developing suggestions that turn out to be no use.

 

[Bombaygin]

Hi Peter,

Thanks for clarifying what you need. My summary sheet is the same as yours consisting of one hour blocks. An availability for half an hour (or possibly only 5 minutes) of a one-hour block would be treated as a full hour. The export sheet would have up to 3000 rows of data with columns A to I.

Here is the screen shot as you requested.

Excel 2010
	A	B	C	D	E	F	G	H	I
1
2	Employee Roster Report
3
4	Period Capacity for all	Total Capacity per Day and Period:	Monday	Tuesday	Wednesday	Thursday	Friday	Saturday	Sunday
5	employees in range:	23195.75 hours can be booked.	3155.62	3030.81	3202.24	3429.8	3484.36	3526.18	3366.74
6
7	Department: Home Support
8
9	Emp.Category: R35
10	Roster Item:	Period Totals:
11	Availability	70	8:00-13:00;13:00-23:00	8:00-13:00;13:00-23:00	13:00-23:00	13:00-23:00	17:00-22:00	N/A	8:00-13:00;13:00-23:00
12
13	Department: Home Support
14
15	Emp.Category: Casual CHW/LPN
16	Roster Item:	Period Totals:
17	Availability	49	7:00-15:00	7:00-15:00	7:00-19:30	7:00-15:00	N/A;Vacation	N/A;Vacation	N/A;Vacation
18
19	Department: Home Support
20
21	Emp.Category: Casual CHW/LPN
22	Roster Item:	Period Totals:
23	Availability	28	7:00-15:00	N/A	7:00-12:00	N/A	N/A	7:00-12:00	7:00-12:00;17:00-22:00
EmployeeRosterReport (1)

 

[Peter_SSs]

Thanks for providing some copyable data & further information about the scale of your data.

I do still have a concern regarding row 4 of this data that I would like more information about. The image in post #3 contains dates in this row. The screen shot in post #4 contains day names.
In addition, the post #3 image had 27 Feb 2016 in column C - a Saturday - whereas post #4 starts with Monday in column C.


Do I need have those issues clarified, or is it just that anything in column C of the data sheet goes into column B of the summary, column D of data to column C of summary & so on for 7 columns?

 

[Bombaygin]

The day of the week starting in column C can be different depending on what date range you choose to run. So the latter of your question is correct; anything in column C of the data sheet goes into column B of the summary, column D of data to column C of summary & so on for 7 columns.

Thanks

 

[Peter_SSs]

So the latter of your question is correct; anything in column C of the data sheet goes into column B of the summary, column D of data to column C of summary & so on for 7 columns.

Give this one a try. Remember to check the sheet names.

Sub Availability_v2()
  Dim a, b(1 To 24, 1 To 7), vRws, vCols, Blocks, StartStop
  Dim r As Long, c As Long, i As Long, j As Long
  
  Application.ScreenUpdating = False
  Sheets("Data").Activate                               '<-Check sheet name
  With Range("A1", Range("A" & Rows.Count).End(xlUp))
    vRws = Application.Transpose(Filter(Evaluate(Replace("transpose(if(#=""availability"",row(#),""|""))", "#", .Address)), "|", False))
  End With
  vCols = Evaluate("transpose(row(3:9))")
  a = Application.Index(Cells, vRws, vCols)
  For r = 1 To UBound(a)
    For c = 1 To 7
      Blocks = Split(a(r, c), ";")
      For i = 0 To UBound(Blocks)
        StartStop = Split(Replace(Blocks(i), "-", ":"), ":")
        If UBound(StartStop) > 2 Then
          If StartStop(3) <> "00" Then StartStop(2) = StartStop(2) + 1
          For j = Val(StartStop(0)) To Val(StartStop(2)) - 1
            b(j + 1, c) = b(j + 1, c) + 1
          Next j
        End If
      Next i
    Next c
  Next r
  With Sheets("Summary").Range("B2:H25")         '<-Check sheet name
    .Value = b
    .Parent.Activate
  End With
  Application.ScreenUpdating = True
End Sub