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
Re: VB - My TimeDiff function
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
Re: VB - My TimeDiff 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
Re: VB - My TimeDiff function
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
Re: VB - My TimeDiff function
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
Re: VB - My TimeDiff 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
Re: VB - My TimeDiff function
True, just made it self explanatory with a comment on the same line.
Re: VB - My TimeDiff function
This is cool. Great code lasts the years! No question about that. Cutting and pasting I go! Thanks!
Re: VB - My TimeDiff function
great code. ive used this on my program.
Re: VB - My TimeDiff function
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
Re: VB - My TimeDiff function
Finally I found this useful VB Snippet! that compatible to VB6
Very useful!