VB - My TimeDiff function

Send 2 date values to this function and it will return the difference in words, in GOOD english with comma's and "and"'s where necesary.

EXAMPLE:

lets say A = 09:30:23 and B = 11:17:22, calling this function, sending A as the 1st parameter and B as the 2nd parameter will return "1 hour, 46 minutes and 59 seconds"

I just use it to determine and display how long someone has been logged in to one of my programs. handy though!


here it is...for anyone that could use it...

Code:

---

Public Function TimeDiffString(dtmStart, dtmEnd) As String
On Error GoTo ErrorHandler

    Dim intHrs, intMins, intSecs As Integer
    Dim strHrsString, strMinsString, strSecsString As String

        'Calculate the mins and secs
        intHrs = DateDiff("h", dtmStart, dtmEnd)
        intMins = DateDiff("n", dtmStart, dtmEnd) Mod 60
        intSecs = DateDiff("s", dtmStart, dtmEnd) Mod 60
       
        'May need to take 1 off the minutes and the hours
        If CInt(Format(dtmEnd, "nn")) < CInt(Format(dtmStart, "nn")) Then intHrs = intHrs - 1
        If CInt(Format(dtmEnd, "ss")) < CInt(Format(dtmStart, "ss")) Then intMins = intMins - 1
       
        'Create the strings
        If intHrs <= 0 Then
            strHrsString = ""
        ElseIf intHrs = 1 Then
            strHrsString = " 1 hour"
        Else
            strHrsString = " " & intHrs & " hours"
        End If
        If intMins <= 0 Then
            strMinsString = ""
        ElseIf intMins = 1 Then
            strMinsString = " 1 minute"
        Else
            strMinsString = " " & intMins & " minutes"
        End If
        If intSecs <= 0 Then
            strSecsString = ""
        ElseIf intSecs = 1 Then
            strSecsString = " 1 second"
        Else
            strSecsString = " " & intSecs & " seconds"
        End If
       
        'If all aren't "" then will need an 'and'
        If strMinsString <> "" And strSecsString <> "" Then
            strMinsString = strMinsString & " and"
            If strHrsString <> "" Then strHrsString = strHrsString & ","
        ElseIf strHrsString <> "" And (strMinsString <> "" Or strSecsString <> "") Then
            strHrsString = strHrsString & " and"
        End If
       
        'Result
        TimeDiffString = strHrsString & strMinsString & strSecsString

CleanUp:
    Exit Function
   
ErrorHandler:
    MsgBox Err.Description, , Err.Number
    Resume CleanUp
End Function

---

i'm a little dissapointed that more people haven't commented...:(

i thought people would find it useful.

If not, how can i change it/use it better etc.

Any ideas/criticism etc are very welcome;)

I for one, found it very useful. In fact, I've already used it in one of my projects. Good job. :D

Sorry to bump such an old post but I gotta give credit where credit is due. I've been searching for a few days for something like this. This does exactly what I need. Good job and thanks for the code.

It has been awhile since this code was originally posted. I just hope they have fixed the bugs during all this time. Try using these two times - "10:00:59", "11:00:58"

Moved from General VB Questions

I just posted something very similar here recently:

http://www.vbforums.com/showthread.php?threadid=245515

Excellent piece of software, just what I was looking for. but for that one error.

This I think should fix it

If intMins < 0 Then <--------- New bit start
intMins = 59
strHrsString = ""
ElseIf intHrs <= 0 Then < ------------- New bit end
strHrsString = ""
ElseIf intHrs = 1 Then
strHrsString = " 1 hour"
Else
strHrsString = " " & intHrs & " hours"
End If


Now all that has to be done is working out the midnight cross.

Asked a colleague to look and he came up with this code, I then converted it to a function and hay-presto there you go. :eek2:
Select the output method by remarking out the desired output.
Now you can get the time difference across any dates, inputs are fully qualified i.e. “12/04/06 10:12:13”

Public Function TimePeriod(StartTime As String, FinishTime As String) As String
Dim MyDays As String
Dim MyHours As Single
Dim MyMinutes As Single
Dim MySeconds As Single
Dim ToRemove As Long
Dim sDate As Date
Dim sTime As String
Dim fDate As Date
Dim fTime As String

sDate = Format(Mid(StartTime, 1, InStr(StartTime, " ") - 1), "dd/mm/yy")
sTime = Format(Mid(StartTime, InStr(StartTime, " ") + 1), "hh:mm:ss")
fDate = Format(Mid(FinishTime, 1, InStr(FinishTime, " ") - 1), "dd/mm/yy")
fTime = Format(Mid(FinishTime, InStr(FinishTime, " ") + 1), "hh:mm:ss")



MySeconds = DateDiff("s", sDate & " " & sTime, fDate & " " & fTime)
MyDays = Fix(((MySeconds / 60) / 60 / 24))
ToRemove = MyDays * 24 ' hours
MyHours = Fix(((MySeconds / 60) / 60) - (MyDays * 24))
ToRemove = Fix((ToRemove * 60) + (MyHours * 60)) 'minutes
MyMinutes = Fix((MySeconds / 60) - ToRemove)
ToRemove = Fix((ToRemove * 60) + (MyMinutes * 60)) 'seconds
MySeconds = MySeconds - ToRemove



TimePeriod = "Days=" & MyDays & " Hours=" & MyHours & " Minutes=" & MyMinutes & " Seconds=" & MySeconds
TimePeriod = MyHours + (MyDays * 24) & ":" & MyMinutes & ":" & MySeconds

End Function

Quote:

---

Originally Posted by Softman

Now all that has to be done is working out the midnight cross.

Asked a colleague to look and he came up with this code, I then converted it to a function and hay-presto there you go. :eek2:
Select the output method by remarking out the desired output.
Now you can get the time difference across any dates, inputs are fully qualified i.e. “12/04/06 10:12:13”

Public Function TimePeriod(StartTime As String, FinishTime As String) As String
Dim MyDays As String
Dim MyHours As Single
Dim MyMinutes As Single
Dim MySeconds As Single
Dim ToRemove As Long
Dim sDate As Date
Dim sTime As String
Dim fDate As Date
Dim fTime As String

sDate = Format(Mid(StartTime, 1, InStr(StartTime, " ") - 1), "dd/mm/yy")
sTime = Format(Mid(StartTime, InStr(StartTime, " ") + 1), "hh:mm:ss")
fDate = Format(Mid(FinishTime, 1, InStr(FinishTime, " ") - 1), "dd/mm/yy")
fTime = Format(Mid(FinishTime, InStr(FinishTime, " ") + 1), "hh:mm:ss")



MySeconds = DateDiff("s", sDate & " " & sTime, fDate & " " & fTime)
MyDays = Fix(((MySeconds / 60) / 60 / 24))
ToRemove = MyDays * 24 ' hours
MyHours = Fix(((MySeconds / 60) / 60) - (MyDays * 24))
ToRemove = Fix((ToRemove * 60) + (MyHours * 60)) 'minutes
MyMinutes = Fix((MySeconds / 60) - ToRemove)
ToRemove = Fix((ToRemove * 60) + (MyMinutes * 60)) 'seconds
MySeconds = MySeconds - ToRemove



TimePeriod = "Days=" & MyDays & " Hours=" & MyHours & " Minutes=" & MyMinutes & " Seconds=" & MySeconds
TimePeriod = MyHours + (MyDays * 24) & ":" & MyMinutes & ":" & MySeconds

End Function

---

When I used your code, I got error "Type Mismatch"
StartTime = "17/11/06 24:00:00" <- This mean 12:00 AM
FinishTime= "18/11/06 01:15:00" <- This mean 01:15 AM

And when I used this format, I got the result "8761:15:0"
StartTime = "17/11/06 00:00:00" <- This mean 12:00 AM
FinishTime= "18/11/06 01:15:00" <- This mean 01:15 AM

Please help me..... :blush: :blush: :blush:

Ps: sorry for my English

It does say to rem out one of the two statements for your output

Output method 1
TimePeriod = "Days=" & MyDays & " Hours=" & MyHours & " Minutes=" & MyMinutes & " Seconds=" & MySeconds

Output Method two
TimePeriod = MyHours + (MyDays * 24) & ":" & MyMinutes & ":" & MySeconds

And the time code 24:00:00 does not exist, it goes from 23:59:59 to 00:00:00


Using your times of
StartTime = "17/11/06 00:00:00" <- This mean 12:00 AM
FinishTime= "18/11/06 01:15:00" <- This mean 01:15 AM


So output method 1 would give you Days=1 Hours=1 Minutes=15 Seconds=0
and output method 2 would give you 25:15:00


It's working

Here's my version to get string representing days:hours:mins:seconds

VB Code:

Public Function DurationStr(ByRef Date1 As Date, Date2 As Date) As String
Dim dblDuration As Double
Dim lngDays As Long
 
   dblDuration = Abs(Date1 - Date2)
   lngDays = Fix(dblDuration)          'strip time (seconds) info
   dblDuration = dblDuration - lngDays 'strip days info
   DurationStr = lngDays & ":" & Format(dblDuration, "Hh:Nn:Ss")
End Function

stripping the days info isn't a required step:

VB Code:

Public Function DurationStr(ByVal Date1 As Date, ByVal Date2 As Date) As String
    Dim dblDuration As Double
    dblDuration = Abs(Date1 - Date2)
    DurationStr = Fix(dblDuration) & Format$(dblDuration, ":Hh:Nn:Ss")
End Function

True, just made it self explanatory with a comment on the same line.

This is cool. Great code lasts the years! No question about that. Cutting and pasting I go! Thanks!

great code. ive used this on my program.

Hello Friend,
Don't Get disappointed, I have registered into the site just to Quote your work, its very useful to me, I really would like to thanks for this type of posting.

Worth spending time to quote such type of posting,

Thanks once again
Bairam Sunil Kumar

Finally I found this useful VB Snippet! that compatible to VB6

Very useful!