Validating Times

[Darren Taylor]

Hi again, as part of my project I will be hiring out Entertainers to Clients using a Booking Date, Start Time and Finish Time.

I was wondering if its possible for me to prevent booking duplications, so for example, Bobo the Clown isnt hired out twice at the same time.

Just seems alot more trickier than your standard integer validation.

Thanks

[marktheman]

Hi,
Not too sure what format you have times but something like this should work

'assume european stadard dates
Public dateEntered1 As String
Public compareDate As String
Public TimeString  As String 
Public CompareTo As String
Public returnMessage As String
dateEntered1 = "30/11/2006"
compareDate = "30/11/2006"
TimeString = "8.00 PM"
CompareTo = "11.00 AM"
returnMessage = dataTimeEqual(dateEntered1,compareDate,TimeString,CompareTo)
MsgBox(returnMessage)

In module:
Public Function dataTimeEqual(dateEntered1 As String, compareDate As String,TimeString As String,CompareTo As String) As String
If (CDate(dateEntered1) = CDate(compareDate)) Then
        If(VBA.CDate(TimeString) < VBA.CDate(CompareTo)) Then
                 dataTimeEqual = "1 < 2 error message"
        ElseIF(VBA.CDate(TimeString) = VBA.CDate(CompareTo)) Then
                 dataTimeEqual = "1 = 2 error message"              
        Else
                 dataTimeEqual = "2 < 1 error message"          
        End If
End IF
End Function

Hope this helps.

[Darren Taylor]

Sorry, i should have explained a little clearer..

The date will be entered via textbox (selecting date from a Calendar) and compared against an array of dates.

I appreciate the help though, even a link to some useful information would be beneficial.

[Ellis Dee]

To begin with, you need to be using true datetime values to make my solution work. Datetimes hold both a date and a time; as a string they look like "5/11/2007 8:37:32 PM". If you don't have your data set up like this, you can still make it work (though you may want to reconsider your design) by using this simple function:

Public Function GetDateTime(pdtmDate As Date, pdtmTime As Date) As Date
    GetDateTime = Format(pdtmDate, "Short Date") & " " & Format(pdtmTime, "Long Time")
End Function

Now the idea is that whenever you try to add a new appointment, (or edit and existing one,) you check the new start and end datetimes against all the existing appointments. This can be optimized by filtering out appointments that are obviously before or after, but be careful how you do that. It is logically possible to have a single appointment span years. (11:00pm New Year's Eve to 1:00am New Year's day: 2 hours spanning 2 years.) Still, proper filtering can greatly speed up your validation.

The solution below will also allow you to specify an optional lag time (in minutes) needed between appointments. For example, you can't finish one job at 2:00pm and then expect to be at the next job also at 2:00pm, since you have to physically drive over to the next job site.

Public Function IsConflict(ByVal pdtmStart1 As Date, ByVal pdtmEnd1 As Date, ByVal pdtmStart2 As Date, ByVal pdtmEnd2 As Date, Optional plngLagMinutes As Long)
    Dim lngLag As Long
    Dim blnConflict As Boolean
    
    ' Convert lag time to seconds, then divide by two
    lngLag = plngLagMinutes * 60 \ 2
    ' Add half of lag time to beginning and end of both ranges
    pdtmStart1 = DateAdd("s", -lngLag, pdtmStart1)
    pdtmEnd1 = DateAdd("s", lngLag, pdtmEnd1)
    pdtmStart2 = DateAdd("s", -lngLag, pdtmStart2)
    pdtmEnd2 = DateAdd("s", lngLag, pdtmEnd2)
    IsConflict = Not (pdtmEnd1 <= pdtmStart2 Or pdtmEnd2 <= pdtmStart1)
End Function

Let me know if you have any questions.

[Ellis Dee]

Ideally you store your appointments in a database. If so, then you can ditch the functions altogether and simply use SQL selects to determine if any conflicts exist.

In such a case, each appointment should hold at least the following datetime values:

ActualBegin
ActualEnd
LagBegin
LagEnd

Such a setup would allow you to set a custom lag time for each appointment; if one happens to be way out in the boonies, you could set extra lag for it.

Without getting into the nitty gritty of SQL statements, your basic conflict check would have this logic:

Select all records Where:
(EventID <> NewEventID) And
(EntertainerID = NewEntertainer) And
((NewLagStart Between LagStart And LagEnd) Or
(NewLagEnd Between LagStart And LagEnd))

This recordset would return all records that conflict for a given entertainer. The "EventID <> NewEventID" ensures the check will function correctly when editing an existing event.

Note that NewEntertainer simply means the talent scheduled for this event. Despite the prefix New, it will reference an already existing entertainer.

[Darren Taylor]

I'm working with text files as apposed to a database, if it's not to much trouble, can you quickly tell me what the variables mean?

For example, pdtmStart1 and pdtmStart2.

Thanks for the help, really appreciated!

[Ellis Dee]

You can send strings and let VB worry about conversions. For example:

?IsConflict("05/12/07 2:00 PM", "05/12/07 5:00 PM", "05/12/07 3:00 PM", "05/12/07 4:00 PM")
True

Or you can send actual datetimes, as returned by the GetDatetime function:

Dim dtmStart1 As Date
Dim dtmEnd1 As Date
Dim dtmStart2 As Date
Dim dtmEnd2 As Date

dtmStart1 = GetDatetime(NewDate, NewStartTime)
dtmEnd1 = GetDatetime(NewDate, NewEndTime)

' Now loop through the existing appointments
Do While Something
    dtmStart2 = GetDatetime(SomeDate, SomeStartTime)
    dtmEnd2 = GetDatetime(SomeDate, SomeEndTime)
    If IsConflict(dtmStart1, dtmEnd1, dtmStart2, dtmEnd2) Then
        MsgBox "There is a conflict"
    End If
Loop

[Ellis Dee]

Feel free to ask for further clarification if needed.