Finding overlapping times and summarizing results by group?

JHarmon

New Member
Joined
Feb 7, 2022
Messages
2
Office Version
  1. 365
Platform
  1. Windows
I have a data set that has client names, dates, and time in/out for each employee (xl2bb copied below). I need to be able to find and summarize the overlapping time where there were 2 or more staff serving a client.

I was able to calculate the number of total hours per line in column H. What I need in a separate column, is just the overlapping time in hours. (Column i) I hard coded the values that I'm looking to get (i3, i9) when there are two entries that overlap. I am even more lost when there are multiple lines that overlap (shaded blue rows 10, 11, 13, 14)

Alternatively, if there is a better way to summarize, by date, by client, the number of hours that are done with 1 staff, 2 staff, 3 staff? Something like the second xl2bb example below?

Thank you for any help you can offer!

DATASET
book1.xlsx
ABCDEFGHI
1ClientDateStaffInOutLocationTOTAL HOURSOVERLAP HOURS
2A9/16/2022X2:30 PM11:00 PMTownsend8.50
3A9/16/2022Y10:00 PM12:00 AMTownsend2.001.000
4A9/16/2022X1:00 PM2:30 PMTownsend1.50
5B9/16/2022X12:00 AM6:00 AMTownsend6.00
6A9/16/2022Y6:00 AM8:03 AMTownsend2.05
7A9/17/2022Y12:00 AM7:00 AMTownsend7.00
8B9/17/2022X7:00 AM8:08 AMTownsend1.13
9B9/17/2022Y7:51 AM7:58 PMTownsend12.120.283
10C9/18/2022Z12:00 AM9:18 AMTownsend9.30
11C9/18/2022Y8:16 AM6:40 PMTownsend10.40
12C9/18/2022X11:18 PM12:00 AMTownsend0.70
13C9/18/2022W8:40 PM11:11 PMTownsend2.52
14C9/18/2022V4:22 PM11:14 PMTownsend6.87
Sheet1
Cell Formulas
RangeFormula
H2:H14H2=MOD(E2-D2,1)*24


Summarized Results
book1.xlsx
LMNO
1ClientDate1:1 Hours2:1 Hours
2A9/16/202220.051
3B9/16/20226
4A9/17/20227
5B9/17/202212.9670.283
Sheet1
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Hello JHarmon,

My suggested solution (download and use at your own risk - but I use an up-to-date virus checking program):

MrExcel_Finding overlapping times and summarizing results by group.xlsm
ABCDEF
1ClientDateStaffInOutLocation
2A16.09.2022X13:00:0014:30:00Townsend
3A16.09.2022X14:30:0023:00:00Townsend
4A16.09.2022Y06:00:0008:03:00Townsend
5A16.09.2022Y22:00:0000:00:00Townsend
6A17.09.2022Y00:00:0007:00:00Townsend
7B16.09.2022X00:00:0006:00:00Townsend
8B17.09.2022X07:00:0008:08:00Townsend
9B17.09.2022Y07:51:0019:58:00Townsend
10C18.09.2022V16:22:0023:14:00Townsend
11C18.09.2022W20:40:0023:11:00Townsend
12C18.09.2022X23:18:0000:00:00Townsend
13C18.09.2022Y08:16:0018:40:00Townsend
14C18.09.2022Z00:00:0009:18:00Townsend
Input


MrExcel_Finding overlapping times and summarizing results by group.xlsm
ABCD
1ClientDatetimeStaffHours [h:mm]
2A16.09.2022 06:00:00Y2:03
3A16.09.2022 08:03:00
4A16.09.2022 13:00:00X1:30
5A16.09.2022 14:30:00X7:30
6A16.09.2022 22:00:00X, Y2:00
7A16.09.2022 23:00:00Y1:00
8A17.09.2022Y7:00
9A17.09.2022 07:00:00
10B16.09.2022X6:00
11B16.09.2022 06:00:00
12B17.09.2022 07:00:00X0:51
13B17.09.2022 07:51:00X, Y0:34
14B17.09.2022 08:08:00Y11:50
15B17.09.2022 19:58:00
16C18.09.2022Z8:16
17C18.09.2022 08:16:00Y, Z2:04
18C18.09.2022 09:18:00Y7:04
19C18.09.2022 16:22:00V, Y4:36
20C18.09.2022 18:40:00V2:00
21C18.09.2022 20:40:00V, W5:02
22C18.09.2022 23:11:00V0:03
23C18.09.2022 23:14:00
24C18.09.2022 23:18:00X0:42
25C19.09.2022
Intermediate


MrExcel_Finding overlapping times and summarizing results by group.xlsm
ABCD
1ClientDate1:1 Hours2:1 Hours
2A16.09.202212:03
3A16.09.20222:00
4A17.09.20227:00
5B16.09.20226:00
6B17.09.202212:41
7B17.09.20220:34
8C18.09.202218:05
9C18.09.202211:42
Output


VBA Code:
Option Explicit

Enum Input_Columns
    ic_LBound = 0
    ic_Client
    ic_Date
    ic_Staff
    ic_In
    ic_Out
    ic_Location
    ic_UBound
End Enum

Enum Intermediate_Columns
    imc_LBound = 0
    imc_Client
    imc_Datetime
    imc_Staff
    imc_Hours
    imc_UBound
End Enum

Enum Output_Columns
    oc_LBound = 0
    oc_Client
    oc_Date
    oc_Hours
End Enum

Sub Client_Hours()
'Sulprobil v0.1 14-Oct-2022
Dim dt                     As Date
Dim dtHours                As Date
Dim dtIn                   As Date
Dim dtOut                  As Date
Dim dtStart                As Date
Dim dtEnd                  As Date
Dim i                      As Long
Dim j                      As Long
Dim k                      As Long
Dim oStaff                 As Object
Dim oHours                 As Object
Dim s                      As String
Dim sClient                As String
Dim sClient2               As String
Dim sClient3               As String
Dim sStaff                 As String
Dim v                      As Variant
Dim vSplit                 As Variant

'Initialize
wsIM.Cells.EntireColumn.Delete
wsIM.Range("A1:D1").FormulaArray = Array("Client", "Datetime", "Staff", "Hours [h:mm]")
wsO.Cells.EntireColumn.Delete
wsO.Range("A1:B1").FormulaArray = Array("Client", "Date")
Set oStaff = CreateObject("Scripting.Dictionary")
Set oHours = CreateObject("Scripting.Dictionary")

'First pass through Input - collect in and out datetimes per client
i = 2
sClient = wsI.Cells(i, ic_Client)
Do While sClient <> ""
    oStaff(wsI.Cells(i, ic_Client) & "|" & wsI.Cells(i, ic_Date) + wsI.Cells(i, ic_In)) = 1
    oStaff(wsI.Cells(i, ic_Client) & "|" & wsI.Cells(i, ic_Date) + _
        IIf(wsI.Cells(i, ic_Out) < wsI.Cells(i, ic_In), 1, 0) + wsI.Cells(i, ic_Out)) = 1
    i = i + 1
    sClient = wsI.Cells(i, ic_Client)
Loop
With wsI.Sort
    .SortFields.Clear
    .SortFields.Add2 Key:=wsI.Range(wsI.Cells(2, ic_In), wsI.Cells(i - 1, ic_In))
    .SetRange wsI.Range(wsI.Cells(2, ic_LBound + 1), wsI.Cells(i - 1, ic_UBound - 1))
    .Apply
    .SortFields.Clear
    .SortFields.Add2 Key:=wsI.Range(wsI.Cells(2, ic_Client), wsI.Cells(i - 1, ic_Client))
    .SortFields.Add2 Key:=wsI.Range(wsI.Cells(2, ic_Date), wsI.Cells(i - 1, ic_Date))
    .SortFields.Add2 Key:=wsI.Range(wsI.Cells(2, ic_Staff), wsI.Cells(i - 1, ic_Staff))
    .SetRange wsI.Range(wsI.Cells(2, ic_LBound + 1), wsI.Cells(i - 1, ic_UBound - 1))
    .Apply
End With
wsI.Cells.EntireColumn.AutoFit
i = 2
For Each v In oStaff.keys
    wsIM.Cells(i, imc_Client) = Split(v, "|")(0)
    wsIM.Cells(i, imc_Datetime) = Split(v, "|")(1)
    i = i + 1
Next v
With wsIM.Sort
    .SortFields.Clear
    .SortFields.Add2 Key:=wsIM.Range(wsIM.Cells(2, imc_Client), _
        wsIM.Cells(i - 1, imc_Client))
    .SortFields.Add2 Key:=wsIM.Range(wsIM.Cells(2, imc_Datetime), _
        wsIM.Cells(i - 1, imc_Datetime))
    .SetRange wsIM.Range(wsIM.Cells(2, imc_Client), wsIM.Cells(i - 1, imc_Datetime))
    .Apply
End With

'Second pass through Input - collect staff and aggregate hours
With Application.WorksheetFunction
i = 2
sClient = wsI.Cells(i, ic_Client)
sStaff = wsI.Cells(i, ic_Staff)
dtIn = wsI.Cells(i, ic_Date) + wsI.Cells(i, ic_In)
dtOut = wsI.Cells(i, ic_Date) + wsI.Cells(i, ic_Out)
j = 2
Do While sClient <> ""
    k = j
    sClient2 = wsIM.Cells(k, imc_Client)
    dtStart = wsIM.Cells(k, imc_Datetime)
    sClient3 = wsIM.Cells(k + 1, imc_Client)
    dtEnd = wsIM.Cells(k + 1, imc_Datetime)
    Do While sClient = sClient2 And sClient2 = sClient3 And dtStart < dtOut
        If dtStart >= dtIn And dtEnd <= dtOut Then
            wsIM.Cells(k, imc_Staff) = wsIM.Cells(k, imc_Staff) & ", " & sStaff
            wsIM.Cells(k, imc_Hours) = wsIM.Cells(k, imc_Hours) + _
                .Min(dtOut, dtEnd) - .Max(dtIn, dtStart)
        End If
        k = k + 1
        sClient2 = wsIM.Cells(k, imc_Client)
        dtStart = wsIM.Cells(k, imc_Datetime)
        sClient3 = wsIM.Cells(k + 1, imc_Client)
        dtEnd = wsIM.Cells(k + 1, imc_Datetime)
    Loop
    i = i + 1
    sClient = wsI.Cells(i, ic_Client)
    sStaff = wsI.Cells(i, ic_Staff)
    dtIn = wsI.Cells(i, ic_Date) + wsI.Cells(i, ic_In)
    dtOut = wsI.Cells(i, ic_Date) + _
        IIf(wsI.Cells(i, ic_Out) < wsI.Cells(i, ic_In), 1, 0) + wsI.Cells(i, ic_Out)
    If sClient <> "" And sClient <> sClient2 Then
        j = k
        Do While sClient <> wsIM.Cells(j, imc_Client)
            j = j + 1
        Loop
    End If
Loop

'Aggregate hours per client per day and show how many members of staff worked those
j = 0
k = 0
Set oHours = Nothing
Set oHours = CreateObject("Scripting.Dictionary")
i = 2
sClient = wsIM.Cells(i, imc_Client)
Do While sClient <> ""
    dt = wsIM.Cells(i, imc_Datetime)
    sStaff = wsIM.Cells(i, imc_Staff)
    If sStaff <> "" Then
        j = UBound(Split(sStaff, ","))
        If k < j Then k = j
        s = sClient & "|" & Int(dt) & "|" & j
        dtHours = wsIM.Cells(i, imc_Hours)
        oHours(s) = oHours(s) + dtHours
        If Left(sStaff & "  ", 2) = ", " Then
            wsIM.Cells(i, imc_Staff) = Right(sStaff, Len(sStaff) - 2)
        End If
    End If
    i = i + 1
    sClient = wsIM.Cells(i, imc_Client)
Loop
wsIM.Cells.EntireColumn.AutoFit
For i = 1 To k
    wsO.Cells(1, i + 2) = i & ":1 Hours"
Next i
i = 2
For Each v In oHours.keys
    vSplit = Split(v, "|")
    wsO.Cells(i, oc_Client) = vSplit(0)
    wsO.Cells(i, oc_Date) = vSplit(1)
    wsO.Cells(i, oc_Hours + vSplit(2) - 1) = oHours(v)
    i = i + 1
Next v
wsO.Cells.EntireColumn.AutoFit
End With
End Sub

Regards,
Bernd
 
Upvote 0
Solution
Bernd, that worked PERFECTLY. Thank you so much for taking the time to help. I'm not very familiar with VBA, and was trying to get a formula or query to fix this. I had ended up just using some xlookups and filter/sumifs to get a more "summarized" view by client, and then doing some manual calculating for the ratios. Your solution feels like magic. Thank you again!
 
Upvote 0

Forum statistics

Threads
1,224,825
Messages
6,181,191
Members
453,021
Latest member
pingpong7117

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top