Convert Text :> Time... Using VBA

You could try this UDF.

Function GetTimeFromString(strTime As String) As Date
Dim dicTimeParts As Object
Dim arrTimeParts As Variant
Dim idx As Long

    Set dicTimeParts = CreateObject("Scripting.Dictionary")
    
    dicTimeParts("h") = 0
    dicTimeParts("m") = 0
    dicTimeParts("s") = 0
    
    arrTimeParts = Split(strTime, " ")
    
    For idx = LBound(arrTimeParts) To UBound(arrTimeParts)
        dicTimeParts(Right(arrTimeParts(idx), 1)) = Left(arrTimeParts(idx), Len(arrTimeParts(idx)) - 1)
    Next idx
    
    GetTimeFromString = TimeSerial(dicTimeParts("h"), dicTimeParts("m"), dicTimeParts("s"))
        
End Function

Hi Norie, based on the function name, I think your last line of code needs to be changed to:

GetTimeFromString = TimeSerial(dicTimeParts("h"), dicTimeParts("m"), dicTimeParts("s"))

Otherwise it returns 0.

Paul

You are right - I changed the name of the function at the last minute and forgot to update it in the body of the code.

It's a user defined function.

You would put the code in a standard module and then use it on a worksheet like any other function.

For example, I put the data you posted in column A and then put this formula in B2 and copied it down.

=GetTimeFromString(A2)

It could also be called from other code.

Not 100% sure what you mean but you could do something like this.

Sub ConvertTimes()
Dim rng As Range
Dim arrData As Variant
Dim idx As Long

    With Sheets("Sheet1")
        Set rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With

    arrData = rng.Value

    For idx = LBound(arrData, 1) To UBound(arrData, 1)
        If arrData(idx, 1) <> "" Then
            arrData(idx, 1) = GetTimeFromString(arrData(idx, 1))
        End If
    Next idx

    rng.Value = arrData

End Sub

For the above to work we need to make a minor change to the function.

Function GetTimeFromString(strTime As Variant) As Date
Dim dicTimeParts As Object
Dim arrTimeParts As Variant
Dim idx As Long

    Set dicTimeParts = CreateObject("Scripting.Dictionary")
    
    dicTimeParts("h") = 0
    dicTimeParts("m") = 0
    dicTimeParts("s") = 0
    
    arrTimeParts = Split(strTime, " ")
    
    For idx = LBound(arrTimeParts) To UBound(arrTimeParts)
        dicTimeParts(Right(arrTimeParts(idx), 1)) = Left(arrTimeParts(idx), Len(arrTimeParts(idx)) - 1)
    Next idx
    
    GetTimeFromString = TimeSerial(dicTimeParts("h"), dicTimeParts("m"), dicTimeParts("s"))
        
End Function

When Mos w d are there what should be the format of result. Is it dd hh:mm:ss or [h]:mm:ss.
And also Mos is be treated as 30 days.

Code for UDF DayAndTime. Format cells for [hh]:mm:ss.

Function DayAndTime(IP As Range)
Dim M
Dim T As Integer, d_ays As Integer, hrs As Integer, mns As Integer, scs As Integer

M = Split(IP.Value, " ")
For T = 0 To UBound(M)
    If InStr(1, M(T), "mos") > 0 Then
    d_ays = 30 * (Replace(M(T), "mos", ""))
    ElseIf InStr(1, M(T), "w") > 0 Then
    d_ays = d_ays + 7 * (Replace(M(T), "w", ""))
    ElseIf InStr(1, M(T), "d") > 0 Then
    d_ays = d_ays + (Replace(M(T), "d", ""))
    ElseIf InStr(1, M(T), "h") > 0 Then
    hrs = 0 + (Replace(M(T), "h", ""))
    ElseIf InStr(1, M(T), "m") > 0 Then
    mns = 0 + (Replace(M(T), "m", ""))
    ElseIf InStr(1, M(T), "s") > 0 Then
    scs = 0 + (Replace(M(T), "s", ""))
    End If

Next T
    
    DayAndTime = TimeSerial((d_ays * 24) + hrs, mns, scs)
    
End Function

Please try
Formula
=SUMPRODUCT((TEXT(MID(0&A2,FIND({"mo","w","d","h","m ","s"},"00"&A2&" mowdhsm ")-3,2),"0;;0;\0"))*{30,7,1,1,1,1}/{1,1,1,24,1440,86400})

or UDF =gTime(A2)

Function gTime(t) As Double

    gTime = Evaluate(Replace("SUMPRODUCT((TEXT(MID(0&#,FIND({""mo"",""w"",""d"",""h"",""m "",""s""},""00""&#&"" mowdhsm "")-3,2),""0;;0;\0""))*{30,7,1,1,1,1}/{1,1,1,24,1440,86400})", "#", t.Address))

End Function