VB - My TimeDiff function

[darre1]

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...




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

[darre1]

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;)

[Hack]

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

[CoderNewbie]

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.

[brucevde]

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"

[MartinLiss]

Moved from General VB Questions

[doofusboy]

I just posted something very similar here recently:

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

[Softman]

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

[afritz]

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

[Softman]

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

[leinad31]

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

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

[bushmobile]

stripping the days info isn't a required step: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

[leinad31]

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

[realbogus]

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

[burn deleon]

great code. ive used this on my program.

[bairamsunil]

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