Results 1 to 17 of 17

Thread: VB - My TimeDiff function

  1. #1

    Thread Starter
    Bouncy Member darre1's Avatar
    Join Date
    May 2001
    Location
    Peterborough, UK
    Posts
    3,828

    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
    Confucious say, "Man standing naked in biscuit barrel not necessarily ****ing crackers."

    Don't forget to format your code in your posts

  2. #2

    Thread Starter
    Bouncy Member darre1's Avatar
    Join Date
    May 2001
    Location
    Peterborough, UK
    Posts
    3,828
    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
    Confucious say, "Man standing naked in biscuit barrel not necessarily ****ing crackers."

    Don't forget to format your code in your posts

  3. #3
    I'm about to be a PowerPoster! Hack's Avatar
    Join Date
    Aug 2001
    Location
    Searching for mendhak
    Posts
    58,333

    Thumbs up

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

  4. #4
    Addicted Member
    Join Date
    Apr 2002
    Location
    Anywhere but here
    Posts
    161
    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.
    -------------------------
    My name says it all!

  5. #5
    PowerPoster
    Join Date
    Oct 2002
    Location
    British Columbia
    Posts
    9,758
    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"

  6. #6

  7. #7
    Fanatic Member doofusboy's Avatar
    Join Date
    Apr 2003
    Posts
    526
    I just posted something very similar here recently:

    http://www.vbforums.com/showthread.php?threadid=245515
    Do canibals not eat clowns because they taste funny?

  8. #8
    New Member
    Join Date
    Apr 2006
    Posts
    2

    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.
    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
    Last edited by Softman; Apr 12th, 2006 at 05:59 AM.

  9. #9
    New Member
    Join Date
    Nov 2006
    Posts
    1

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

    Ps: sorry for my English

  10. #10
    New Member
    Join Date
    Apr 2006
    Posts
    2

    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

  11. #11
    PowerPoster
    Join Date
    Nov 2002
    Location
    Manila
    Posts
    7,629

    Re: VB - My TimeDiff function

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

    VB Code:
    1. Public Function DurationStr(ByRef Date1 As Date, Date2 As Date) As String
    2. Dim dblDuration As Double
    3. Dim lngDays As Long
    4.  
    5.    dblDuration = Abs(Date1 - Date2)
    6.    lngDays = Fix(dblDuration)          'strip time (seconds) info
    7.    dblDuration = dblDuration - lngDays 'strip days info
    8.    DurationStr = lngDays & ":" & Format(dblDuration, "Hh:Nn:Ss")
    9. End Function

  12. #12
    Oi, fat-rag! bushmobile's Avatar
    Join Date
    Mar 2004
    Location
    on the poop deck
    Posts
    5,592

    Re: VB - My TimeDiff function

    stripping the days info isn't a required step:
    VB Code:
    1. Public Function DurationStr(ByVal Date1 As Date, ByVal Date2 As Date) As String
    2.     Dim dblDuration As Double
    3.     dblDuration = Abs(Date1 - Date2)
    4.     DurationStr = Fix(dblDuration) & Format$(dblDuration, ":Hh:Nn:Ss")
    5. End Function

  13. #13
    PowerPoster
    Join Date
    Nov 2002
    Location
    Manila
    Posts
    7,629

    Re: VB - My TimeDiff function

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

  14. #14
    Lively Member
    Join Date
    Nov 2006
    Location
    San Pedro, CA
    Posts
    104

    Re: VB - My TimeDiff function

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

  15. #15
    Member
    Join Date
    Jul 2007
    Posts
    59

    Re: VB - My TimeDiff function

    great code. ive used this on my program.

  16. #16
    New Member
    Join Date
    Feb 2009
    Posts
    1

    Resolved 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

  17. #17
    New Member GywGod133's Avatar
    Join Date
    Jul 2015
    Location
    Quezon City, Philippines
    Posts
    6

    Re: VB - My TimeDiff function

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

    Very useful!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width