Changing Hours, minutes, seconds to hours

[Guzzlr]

Hello
I am having trouble with vba to change:
2 Hour - 55 Minutes - 22 Seconds to an hour decimal, which equals 2.92 hours.

Any help is greatly appreciated.
Thank you

 

[Guzzlr]

Cubist has already provided a Function version but since you have provided information for running a macro try this on a copy of your workbook.

At this stage it is outputting to the next empty column in the spreadsheet.
If you have validated the output and want it to overwrite column L that is a simple modification.

Sub ConvertStringToTime()
   
    Dim ws As Worksheet
    Dim rngTimeTxt As Range, arr As Variant
    Dim rngOut As Range
    Dim splitTime As Variant, partTime As String
    Dim rowHdg As Long, i As Long, j As Long
    Dim hrs As Long
    Dim mins As Long
    Dim secs As Long
   
    Set ws = ActiveSheet
    rowHdg = 5
    With ws
        Set rngTimeTxt = .Range(.Cells(rowHdg + 1, "L"), .Cells(Rows.Count, "L").End(xlUp))
        arr = rngTimeTxt.Value
    End With
   
    Set rngOut = ws.Cells(rowHdg, Columns.Count).End(xlToLeft).Offset(1, 1)
   
    For i = 1 To UBound(arr)
        hrs = 0
        mins = 0
        secs = 0
        splitTime = Split(Trim(arr(i, 1)), " ")
        For j = 0 To UBound(splitTime)
            partTime = splitTime(j)
            Select Case True
                Case UCase(partTime) Like "HOUR*"
                    hrs = Val(splitTime(j - 1))
                Case UCase(partTime) Like "MINUTE*"
                    mins = Val(splitTime(j - 1))
                Case UCase(partTime) Like "SECOND*"
                    secs = Val(splitTime(j - 1))
                Case Else
                    ' do nothing
            End Select
        Next j
        arr(i, 1) = 24 * TimeSerial(hrs, mins, secs)
    Next i
   
    'rngOut.Offset(-1).Value = "Est Duration (hrs)"         <--- Leave heading for now, easier to rerun
    rngOut.Resize(UBound(arr)) = arr
End Sub

I will try this and report back. This is a significant time spent so thank you very much for your help.
Thanks!

 

[Guzzlr]

I will try this and report back. This is a significant time spent so thank you very much for your help.
Thanks!

It may be working, let me try some more things.

 

[Guzzlr]

I will try this and report back. This is a significant time spent so thank you very much for your help.
Thanks!

Thank you Alex (and Cubist) for the help, the vba code is working well!

 

[Guzzlr]

Cubist has already provided a Function version but since you have provided information for running a macro try this on a copy of your workbook.

At this stage it is outputting to the next empty column in the spreadsheet.
If you have validated the output and want it to overwrite column L that is a simple modification.

Sub ConvertStringToTime()
   
    Dim ws As Worksheet
    Dim rngTimeTxt As Range, arr As Variant
    Dim rngOut As Range
    Dim splitTime As Variant, partTime As String
    Dim rowHdg As Long, i As Long, j As Long
    Dim hrs As Long
    Dim mins As Long
    Dim secs As Long
   
    Set ws = ActiveSheet
    rowHdg = 5
    With ws
        Set rngTimeTxt = .Range(.Cells(rowHdg + 1, "L"), .Cells(Rows.Count, "L").End(xlUp))
        arr = rngTimeTxt.Value
    End With
   
    Set rngOut = ws.Cells(rowHdg, Columns.Count).End(xlToLeft).Offset(1, 1)
   
    For i = 1 To UBound(arr)
        hrs = 0
        mins = 0
        secs = 0
        splitTime = Split(Trim(arr(i, 1)), " ")
        For j = 0 To UBound(splitTime)
            partTime = splitTime(j)
            Select Case True
                Case UCase(partTime) Like "HOUR*"
                    hrs = Val(splitTime(j - 1))
                Case UCase(partTime) Like "MINUTE*"
                    mins = Val(splitTime(j - 1))
                Case UCase(partTime) Like "SECOND*"
                    secs = Val(splitTime(j - 1))
                Case Else
                    ' do nothing
            End Select
        Next j
        arr(i, 1) = 24 * TimeSerial(hrs, mins, secs)
    Next i
   
    'rngOut.Offset(-1).Value = "Est Duration (hrs)"         <--- Leave heading for now, easier to rerun
    rngOut.Resize(UBound(arr)) = arr
End Sub

Just out of curiosity, you speak of a simple modification to overright the origianl data in Column L. I am doing it by cutting and inserting into Column L. is there another way to incorporate inside this?
Thanks

 

[Alex Blakenburg]

I am not at a computer at the moment but if you are happy to overwrite what you had in column L, just replace this:
rngOut.Resize(UBound(arr)) = arr
With this:
rngTimeTxt.Value = arr

 

[Peter_SSs]

@Guzzlr
If you wish to mark a post as the solution you may do so but please mark one that does have a solution, not like post 21.
I have removed the solution mark from that post.

 

[smozgur]

Thank you Alex (and Cubist) for the help, the vba code is working well!

The marked solution has been changed accordingly. In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers. No further action is required for this thread.