Hour calculator from a single cell with two values

Question

I am creating a new rota. (I'm a team leader in a pub but I normally handle the tech issues).

I want to calculate the hours as a running total. The difficult bit is that the user enters hours in a single cell as follows.

1100 - 1600

I need to make Excel fit the user.

I want is to take the info from the cell, split it in two and then calculate the hours, adding them to a running total which is then put into a cell at the end of each person's week on the rota.

I've basic knowledge of Python. I've got about 3000 tabs open from Stack Overflow but couldn't find anything that worked for me.

user_8107092 · Answer

The process of changing text data to time data should be preceded. Then you just need to calculate the difference between the two and sum them up. You can use Split function and Timeserial function.

Sub test()
    Dim rngDB As Range
    Dim vDB As Variant, vR() As Variant
    Dim vSplit As Variant
    Dim Ws As Worksheet
    Dim i As Long, r As Long
    Dim s1 As String, s2 As String
    
    
    Set Ws = ActiveSheet 'set worksheet, set Ws = Sheets(1)
    With Ws
        Set rngDB = .Range("a1", .Range("a" & Rows.Count).End(xlUp)) ' set data range
    End With
    
    vDB = rngDB 'get value from range to 2D array
    r = UBound(vDB, 1)
    ReDim vR(1 To r, 1 To 3) 'make new 2D array
    For i = 1 To r
        vSplit = Split(vDB(i, 1), "-")
        
        s1 = Trim(vSplit(0)) '1100
        s2 = Trim(vSplit(1)) '1600
        
        vR(i, 1) = TimeSerial(Left(s1, 2), Right(s1, 2), 0) '11:00
        vR(i, 2) = TimeSerial(Left(s2, 2), Right(s2, 2), 0) '16:00
        vR(i, 3) = vR(i, 2) - vR(i, 1) '16:00 - 11:00
    Next i
    
    'Wirte  Result array vR to Sheet cell "c1"
    With Ws
        With .Range("c1").Resize(r, 3)
            .Value = vR
            .NumberFormatLocal = "hh:mm"
        End With
    End With
End Sub

Hour calculator from a single cell with two values

1 Answers

sheet image