Date Rules - text box one date leads to another

[Rx_]

See attachment (example of what should not be allowed ) :

Four date fields - da' Rules:

1. None are required fields
2. values may arrive in any order for data entry with adjustments later
3. 1 must be <= 2 <=3 <=4 (order from top to bottom)

So, if date expires (4) is entered first, then the date requested (1) arrives later. Don't allow the data entry person to enter a 1 that is after a 4. They must make a call and figure out what really happened.

This is a 2-way - validate the date field issue, that must accomodate nulls. This might come in handy for others.

Was thinking about a Select Case or maybe even an array.
Instead, a cup of coffee sounds good.

 

[SpentGeezer]

Try this one from the Spent Geezer's Association:

 

[SpentGeezer]

A thought: You might want to check the dates. They work for November dates but not thoroughly tested and may have to be converted to US style. If they do I have a module that I can put in the DB and repost.

 

[Rx_]

Great code! Thanks very much.
Good use of the If ... Else If statement! The logic is spot on for my request. Thanks. This really helps verify the logic design.
Was considering a Select Case statement to determine what the first populated textbox and then use your logic from that point.

Dim FirstControlWithDate As String
' dt_Arch_Req   a.k.a.  Date Requested  1
' dt_survey     a.k.a.  Date Surveyed   2
' Dt_Arch_rpt   a.k.a   Date Received   3
' dt_Survey_exp a.k.a.  date Expires    4
Select Case True
    Case Not IsNull(Me.Dt_Arch_Req)
        FirstControlWithDate = "Me.Dt_Arch_Req" ' 1
    Case Not IsNull(Me.Dt_Survey)
        FirstControlWithDate = "Me.Dt_Survey"   ' 2
    Case Not IsNull(Me.Dt_Arch_Rpt)
        FirstControlWithDate = "Me.Dt_Arch_Rpt" ' 3
    Case Else
        FirstControlWithDate = "Me.dt_Survey_exp" ' 4 (last only)
End Select
' have not made a decision on if to return the name of the control or a number that could be used in the next Select Case statement, and use something like your "If" statements. 
'The overall DateRule function return a True / False for each text box to evaluate.
' Work in progress...

In your demo, the Calendar control module is the central point for date rule validation. My case uses Access 2007 text box with Show Date Picker "for dates". Have built a function that returns true/false for each controls update.

Will plan to finish this up and post the result here. It will be your logic and idea formatted for a slightly different form.

 

[Rx_]

Updated Code:
Created a Function that returns True /False to Cancle of each textbox update. In this case setting the textbox value back to "" conflicted with the event.
Instead, use the text box's .Undo event
If data is migrated into the table, this will not "fix" things. A change on migrated data that does not meet the rules will just undo the date back to the migrated data instead of deleting the data.
Still, for entering new data into blank text boxes, in any order, this will force the users to be more aware of the rule of date orders.

While this looks complex, using the search and replace for the procedure, an update in about 8 replacements can be done quickly.

' example of caller and of function (do this for each of the 4 textboxes).
Private Sub Dt_Survey_BeforeUpdate(Cancel As Integer)
On Error Resume Next
    Cancel = DateRules4Way("Dt_Survey")
End Sub
 
Private Sub Dt_Survey_Exp_BeforeUpdate(Cancel As Integer)
On Error Resume Next
    Cancel = DateRules4Way("Dt_Survey_Exp")
End Sub
 
Function DateRules4Way(CallersName As String) As Boolean
 ' This comment will really help with a search / replace task     
      ' dt_Arch_Req   a.k.a.  Date Requested  1
      ' dt_survey     a.k.a.  Date Surveyed   2
      ' Dt_Arch_rpt   a.k.a   Date Received   3
      ' dt_Survey_exp a.k.a.  date Expires    4
 
10    If CallersName = "Dt_Arch_Req" Then
20        If Not IsNull(Me.Dt_Arch_Req.Value) Then
30            If Not Me.Dt_Arch_Req.Value <= Me.Dt_Survey_Exp.Value Then
40                MsgBox "The new date enterd  is Past Date Expires date"
50                Me.Dt_Arch_Req.Undo
                   ' setting Me.Dt_Arch_Req.Value = ""      conflicted with event
60                DateRules4Way = True
70                Exit Function
80            End If
90        End If
100       If Not IsNull(Me.Dt_Arch_Rpt.Value) Then
110           If Not Me.Dt_Arch_Req.Value <= Me.Dt_Arch_Rpt.Value Then
120               MsgBox "The new date enterd  is Past Date Received date"
130               Me.Dt_Arch_Req.Undo
140               DateRules4Way = True
150               Exit Function
160           End If
170       End If
180       If Not IsNull(Me.Dt_Survey.Value) Then
190           If Not Me.Dt_Arch_Req.Value <= Me.Dt_Survey.Value Then
200               MsgBox "The new date enterd  is Past Date Surveyed date"
210               Me.Dt_Arch_Req.Undo
220               DateRules4Way = True
230               Exit Function
240           End If
250       End If
260   ElseIf CallersName = "Dt_Survey" Then
270       If Not IsNull(Me.Dt_Survey_Exp.Value) Then
280           If Not Me.Dt_Survey.Value <= Me.Dt_Survey_Exp.Value Then
290               MsgBox "The new date enterd  is Past Date Expires date"
300               Me.Dt_Survey.Undo
310               DateRules4Way = True
320               Exit Function
330           End If
340       End If
350       If Not IsNull(Me.Dt_Arch_Rpt.Value) Then
360           If Not Me.Dt_Survey.Value <= Me.Dt_Arch_Rpt.Value Then
370               MsgBox "The new date enterd  is Past Date Received date"
380               Me.Dt_Survey.Undo
390               DateRules4Way = True
400               Exit Function
410           End If
420       End If
430       If Not IsNull(Me.Dt_Arch_Req.Value) Then
440           If Not Me.Dt_Arch_Req.Value <= Me.Dt_Survey.Value Then
450               MsgBox "The new date enterd  is before Date Received date"
460               Me.Dt_Survey.Undo
470               DateRules4Way = True
480               Exit Function
490           End If
500       End If
510   ElseIf CallersName = "Dt_Arch_Rpt" Then
520       If Not IsNull(Me.Dt_Survey_Exp.Value) Then
530           If Not Me.Dt_Arch_Rpt.Value <= Me.Dt_Survey_Exp.Value Then
540               MsgBox "The new date enterd  is Past Date Expires date"
550               Me.Dt_Arch_Rpt.Undo
560               DateRules4Way = True
570               Exit Function
580           End If
590       End If
600       If Not IsNull(Me.Dt_Survey.Value) Then
610           If Not Me.Dt_Survey.Value <= Me.Dt_Arch_Rpt.Value Then
620               MsgBox "The new date enterd  is before Date Surveyed date"
630               Me.Dt_Arch_Rpt.Undo
640               DateRules4Way = True
650               Exit Function
660           End If
670       End If
680       If Not IsNull(Me.Dt_Arch_Req.Value) Then
690           If Not Me.Dt_Arch_Req.Value <= Me.Dt_Arch_Rpt.Value Then
700               MsgBox "The new date enterd  is before Date Received date"
710               Me.Dt_Arch_Rpt.Undo
720               DateRules4Way = True
730               Exit Function
740           End If
750       End If
760   ElseIf CallersName = "dt_Survey_exp" Then
770       If Not IsNull(Me.Dt_Arch_Rpt.Value) Then
780           If Not Me.Dt_Arch_Rpt.Value <= Me.Dt_Survey_Exp.Value Then
790               MsgBox "The new date enterd  is before Date Received date"
800               Me.Dt_Survey_Exp.Undo
810               DateRules4Way = True
820               Exit Function
830           End If
840       End If
850       If Not IsNull(Me.Dt_Survey.Value) Then
860           If Not Me.Dt_Survey.Value <= Me.Dt_Arch_Rpt.Value Then
870               MsgBox "The new date enterd  is before Date Surveyed date"
880               Me.Dt_Survey_Exp.Undo
890               DateRules4Way = True
900               Exit Function
910           End If
920       End If
930       If Not IsNull(Me.Dt_Arch_Req.Value) Then
940           If Not Me.Dt_Arch_Req.Value <= Me.Dt_Survey.Value Then
950               MsgBox "The new date enterd  is before Date Received date"
960               Me.Dt_Survey_Exp.Undo
970               DateRules4Way = True
980               Exit Function
990           End If
1000      End If
1010  End If
End Function