Macro help - matching times to periods

[CJW_14]

Hi All,

Could I get some help with a macro?

In columns A/B, I have a set of times. I want to compare those times to the period start/ end times in column E/F. Based on where the majority of hours fall, in relation to the periods, I want to insert the period name into column C.

Example below

Thanks Heaps!

2021-03-30_081603.jpg

[Paul_Hossler]

Q: Is C2 correct? (4:00 - 8:00)

It seems to me that there are 3 hours (4:00 - 7:00) before the Morning shift and only 1 hour (7:00 - 8:00) during Morning shift

Capture.JPG

Option Explicit


Const cMinPerDay As Long = 1440


Function PeriodName(tStart As Long, tEnd As Long, rDefinition As Range) As Variant
    Dim i As Long
    Dim A(2 To 4, 1 To 3) As Long
    Dim iStart As Long, iEnd As Long
    Dim nMorn As Long, nEven As Long, nNight As Long
    
    'convert everything to minutes past midnight
    iStart = MinPastMidnight(tStart)
    iEnd = MinPastMidnight(tEnd)
    If iEnd < iStart Then iEnd = iEnd + cMinPerDay
    
    With rDefinition
        For i = 2 To 4
            A(i, 1) = MinPastMidnight(.Cells(i, 1).Value)
            A(i, 2) = MinPastMidnight(.Cells(i, 2).Value)
            If A(i, 1) >= A(i, 2) Then A(i, 2) = A(i, 2) + cMinPerDay
        Next i
    End With
    
    'bracket start of morning
    If iStart <= A(2, 1) And A(2, 1) < iEnd Then
        nNight = A(2, 1) - iStart
        nMorn = iEnd - A(2, 1)
        nEven = 0
        
    'bracket start of evening
    ElseIf iStart <= A(3, 1) And A(3, 1) < iEnd Then
        nMorn = A(3, 1) - iStart
        nEven = iEnd - A(3, 1)
        nNight = 0
        
    'bracket start of night
    ElseIf iStart <= A(4, 1) And A(4, 1) < iEnd Then
        nEven = A(4, 1) - iStart
        nNight = iEnd - A(4, 1)
        nMorn = 0
    End If
    
    If nMorn >= nEven And nMorn >= nNight Then
        PeriodName = "Morning"
    ElseIf nEven >= nMorn And nEven >= nNight Then
        PeriodName = "Evening"
    ElseIf nNight >= nMorn And nNight >= nEven Then
        PeriodName = "Night"
    End If
End Function




Function MinPastMidnight(L As Long) As Long
    Dim S As String
    S = Format(L, "0000")
    MinPastMidnight = 60 * Left(S, 2) + Right(S, 2)
End Function

[CJW_14]

Q: Is C2 correct? (4:00 - 8:00)

It seems to me that there are 3 hours (4:00 - 7:00) before the Morning shift and only 1 hour (7:00 - 8:00) during Morning shift

Oops I'm terrible, correct that should be night thanks so much for this, Ill run it shortly.

[Paul_Hossler]

Our posts crossed in the mail

I edited my first to add a suggested user defined function

I found the math worked better to convert and use minutes past midnight

[CJW_14]

I thought that was the case, I replied then realised you had posted the code already

Works great, thanks again.