Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations wOOdy-Soft on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Date difference problem 1

Status
Not open for further replies.

mfd777

Programmer
Sep 21, 1999
53
IE
Hi All. I have a text box in general date format on a form (19/02/01 23:32:00). When I click a command button on this form, this sets the value of a variabel "timetorun". The code basically loops until now()>timetorun and then it runs a number of macros. This all works fine. My problem is that I have another textbox on the form that I would like to show the time remaining until run time e.g
2 days, 13 hours, 6 mins. Any suggestions? Any compution I do looks like crazy figures.
 
Hi
You can use the datediff function to find the difference between two dates. Both number of days, hour and minutes.
But to get your result in a format like
2 days, 4 hours and 21 minutes remaining.
you need to use the Mod function.

The function below returns a string that you should be able to use in the code of your form, like this:
forms!myform!timeremaining=timeLeft(now(),timetorun)

Here is the function:
Function timeleft(time1 As Date, time2 As Date) as string
'returns string containing the time remaining
'between time1 and time2 in the format
'X days Y hours and Z minutes
'By Tom Birch Hansen
On Error GoTo timeLeftError:
dim dday,dh,dm
dday = DateDiff("d", time1, time2)
dh = DateDiff("h", time1, time2)
dm = DateDiff("n", time1, time2)
dh = dh Mod 24
dm = dm Mod 60
timeleft = dday & " days, " & dh & " hours and " & dm & " minutes"
Exit Function
timeLeftError:
Debug.Print Err.Description
timeleft = "Error evaluating time left."
End Function


Good luck with it.

Tom -------------------
Freetime is for training.
 
Well, I would taks issue with " ... you need to use the Mod function ..."

Code:
Public Function basTimeToGo(TimeIn As Date)

    Dim TotTime As Double
    Dim Secs As Double
    Dim Mins As Double
    Dim Hrs As Double
    Dim Days As Double
    Dim tmpTimeToGo As String
    Dim Interval As Long


    Const SecPerMin = 60#
    Const MinPerHr = 60
    Const HrPerDay = 24

    TotTime = DateDiff("s", #4/12/2001 12:21:18 PM#, TimeIn)        'Testing
'    TotTime = DateDiff("s", Now, TimeIn)       'Real

    Interval = (HrPerDay * MinPerHr * SecPerMin)
    Days = TotTime \ Interval
    TotTime = TotTime - (Days * Interval)

    Interval = (MinPerHr * SecPerMin)
    Hrs = TotTime \ Interval
    TotTime = TotTime - (Hrs * Interval)

    Interval = (SecPerMin)
    Mins = TotTime \ Interval
    TotTime = TotTime - (Mins * Interval)

    Secs = TotTime
    TotTime = TotTime - (Secs)

    If (Days > 0) Then
        tmpTimeToGo = Days & "Day"
        If (Days > 1) Then
            tmpTimeToGo = tmpTimeToGo & "s "
         Else
            tmpTimeToGo = tmpTimeToGo & " "
        End If
    End If

    If (Hrs > 0) Then
        tmpTimeToGo = tmpTimeToGo & " " & Hrs & "Hr"
        If (Hrs > 1) Then
            tmpTimeToGo = tmpTimeToGo & "s "
         Else
            tmpTimeToGo = tmpTimeToGo & " "
        End If
    End If

    If (Mins > 0) Then
        tmpTimeToGo = tmpTimeToGo & " " & Mins & "Min"
        If (Mins > 1) Then
            tmpTimeToGo = tmpTimeToGo & "s "
         Else
            tmpTimeToGo = tmpTimeToGo & " "
        End If
    End If

    If (Secs > 0) Then
        tmpTimeToGo = tmpTimeToGo & " " & Secs & "Sec"
        If (Secs > 1) Then
            tmpTimeToGo = tmpTimeToGo & "s "
         Else
            tmpTimeToGo = tmpTimeToGo & " "
        End If
    End If

    basTimeToGo = tmpTimeToGo

End Function

Not that this is easier or better, it just gets past the NEED" for the mod function. It also, IMHO, is quite a bit easier to understand. It could also be vastly compacted, but I chose to leave it "UnRolled" to make it easier to understand, as I expect that anyone asking this level of question is seeking both an answer and an understanding of the topic.




MichaelRed
redmsp@erols.com

There is never time to do it right but there is always time to do it over
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top