School Leaving Date - depending on age between dates

[JacD]

I have an access database (MS Access 2002,) which stores school pupils information and I have very limited knowledge on VBA. Hopefully someone can help solve this one for me.


I have a form named frmPupils which contains the Date of Birth (field name - DOB).

I want to add a textbox to the form which will display a date that the pupil is
elegible to leave school, which is dependant on what is entered in the DOB field.


There are two possible school leaving dates in the year.
31st May and 31st December.

If a pupil's 16th birthday is on or between 1st March and 30th September
they can leave school on 31st May of that year.

If a pupil's 16th birthday is on or between 1st October until end of February,
28th or 29th if it's a leap year!
Then they can leave school on 31st December.

eg. If DOB = 16th August 1992, their 16th birthday is in August 2008,
(within the period between 1st March to 30th September),
so they can leave school on 31st May 2008.

If DOB = 16th February 1993, their 16th birthday will be in February 2009,
(within the period between 1st October to end of February),
so they can leave school on 31st December 2008.


Any help would be much appreciated.

[ADezii]

Just subscribing, I'll return later and see what I can come up with.

[ADezii]

Here is the general idea, assuming youo have a Text Box named txtEligibleToLeave on the Form:

Dim dte16thBirthday As Date
 
'Must contain some Value and it must be a Date
If IsNull(Me![DOB]) Or Not IsDate(Me![DOB]) Then Exit Sub
 
dte16thBirthday = DateAdd("yyyy", 16, CDate(Me![DOB]))
 
If dte16thBirthday >= #3/1/2008# And dte16thBirthday <= #9/30/2008# Then
  Me![txtEligibleToLeave] = "5/31/2008"
ElseIf dte16thBirthday >= #10/1/2008# And dte16thBirthday <= #2/28/2009# Then
  Me![txtEligibleToLeave] = "12/31/2008"
Else
  'not sure what you want to do here
End If

[JacD]

Thank you for your input and quick response.

I need it to be able to show leaving dates no matter what age they are at present.

So even if their DOB is 10th February 2000 (currently aged 8), I want it to show their expected leaving date in years to come when they do reach 16 between the dates mentioned, if that makes sense.

DOB = 10th February 2000
Expected Leaving Date to show as - 31st December 2015

or

DOB = 7th September 2002
Expected Leaving Date to show as - 31st May 2018

Hope you can help again. Thanks in advance

[ADezii]

Assuming you have 2 Text Boxes named txtDOB (Date of Birth), and txtEligible (to receive the Eligibility Date), place the following code in the AfterUpdate() Event of txtDOB and let me know if it produced the requested results:

Private Sub txtDOB_AfterUpdate()
Dim dte16th As Date
 
'Must contain some Value and it must be a Date
If IsNull(Me![txtDOB]) Or Not IsDate(Me![txtDOB]) Then Exit Sub
 
dte16th = DateAdd("yyyy", 16, CDate(Me![txtDOB]))
 
If dte16th >= DateSerial(Year(dte16th), 3, 1) And _
   dte16th <= DateSerial(Year(dte16th), 9, 30) Then
  Me![txtEligible] = DateSerial(Year(dte16th), 5, 31)
Else
  Me![txtEligible] = DateSerial(Year(dte16th) - 1, 12, 31)
End If
End Sub

[JacD]

Your almost there, it's looking very promising though. It's working fine for pupils who leave on 31st May.

The problem is with the December leaving date -

Else
Me![txtEligible] = DateSerial(Year(dte16th) - 1, 12, 31)

It needs split up further as only those with a birthday between 1st Jan and 29th Feb would be allowed to leave the year before they are 16 years old (on 31st December)

eg. Aged 16 on 5th February 2008, a pupil can leave on 31st Dec 2007.

And those aged 16 between 1st October 2007 and 31st Dec 2007 could leave on 31st Dec 2007, which I guess would look like the following? (without the -1)?

Me![txtEligible] = DateSerial(Year(dte16th), 12, 31)

Leaving the code as it is is making a pupil aged 16 between Oct and Dec eligible to leave the year before they should, but is showing perfectly correct for those with a birthday between Jan and Feb. So somehow I'd need both codes to show for 31st December leavers.

The other thing I noticed, when entering a DOB, it updates the txtEligible but when scrolling to another record, it shows the same eligible date as the last record I entered a DOB? Any thoughts?

It's confusing I know! Thanks for your time. Hope you can help?

[JacD]

I managed to add a bit to your code and it is now working exactly as I need it.

Private Sub DOB_AfterUpdate()

Dim dte16th As Date

'Must contain some Value and it must be a Date
If IsNull(Me![DOB]) Or Not IsDate(Me![DOB]) Then Exit Sub

dte16th = DateAdd("yyyy", 16, CDate(Me![DOB]))

If dte16th >= DateSerial(Year(dte16th), 3, 1) And _
dte16th <= DateSerial(Year(dte16th), 9, 30) Then
Me![txtEligible] = DateSerial(Year(dte16th), 5, 31)
Else
If dte16th >= DateSerial(Year(dte16th), 10, 1) And _
dte16th <= DateSerial(Year(dte16th), 12, 31) Then
Me![txtEligible] = DateSerial(Year(dte16th), 12, 31)

Else
If dte16th >= DateSerial(Year(dte16th), 1, 1) And _
dte16th < DateSerial(Year(dte16th), 3, 1) Then
Me![txtEligible] = DateSerial(Year(dte16th) - 1, 12, 31)
End If
End If
End If

End Sub

Thanks again for all your help with this. It's very much appreciated.
Jacqueline :)

[ADezii]

Your almost there, it's looking very promising though. It's working fine for pupils who leave on 31st May.

The problem is with the December leaving date -

Else
Me![txtEligible] = DateSerial(Year(dte16th) - 1, 12, 31)

It needs split up further as only those with a birthday between 1st Jan and 29th Feb would be allowed to leave the year before they are 16 years old (on 31st December)

eg. Aged 16 on 5th February 2008, a pupil can leave on 31st Dec 2007.

And those aged 16 between 1st October 2007 and 31st Dec 2007 could leave on 31st Dec 2007, which I guess would look like the following? (without the -1)?

Me![txtEligible] = DateSerial(Year(dte16th), 12, 31)

Leaving the code as it is is making a pupil aged 16 between Oct and Dec eligible to leave the year before they should, but is showing perfectly correct for those with a birthday between Jan and Feb. So somehow I'd need both codes to show for 31st December leavers.

The other thing I noticed, when entering a DOB, it updates the txtEligible but when scrolling to another record, it shows the same eligible date as the last record I entered a DOB? Any thoughts?

It's confusing I know! Thanks for your time. Hope you can help?

The other thing I noticed, when entering a DOB, it updates the txtEligible but when scrolling to another record, it shows the same eligible date as the last record I entered a DOB? Any thoughts?

txtEligible is not 'Bound' to any underlying Field, namely it has no Control Source.

[ADezii]

I managed to add a bit to your code and it is now working exactly as I need it.

Private Sub DOB_AfterUpdate()

Dim dte16th As Date

'Must contain some Value and it must be a Date
If IsNull(Me![DOB]) Or Not IsDate(Me![DOB]) Then Exit Sub

dte16th = DateAdd("yyyy", 16, CDate(Me![DOB]))

If dte16th >= DateSerial(Year(dte16th), 3, 1) And _
dte16th <= DateSerial(Year(dte16th), 9, 30) Then
Me![txtEligible] = DateSerial(Year(dte16th), 5, 31)
Else
If dte16th >= DateSerial(Year(dte16th), 10, 1) And _
dte16th <= DateSerial(Year(dte16th), 12, 31) Then
Me![txtEligible] = DateSerial(Year(dte16th), 12, 31)

Else
If dte16th >= DateSerial(Year(dte16th), 1, 1) And _
dte16th < DateSerial(Year(dte16th), 3, 1) Then
Me![txtEligible] = DateSerial(Year(dte16th) - 1, 12, 31)
End If
End If
End If

End Sub

Thanks again for all your help with this. It's very much appreciated.
Jacqueline :)

You are quite welcome, Jacqueline and way to jump in and provide the final solution to your problem!. In the future, you may wish to incorporate Code Tags in your Code for the sake of clarity and readability as in:

Private Sub DOB_AfterUpdate()
Dim dte16th As Date
 
'Must contain some Value and it must be a Date
If IsNull(Me![DOB]) Or Not IsDate(Me![DOB]) Then Exit Sub
 
dte16th = DateAdd("yyyy", 16, CDate(Me![DOB]))
 
If dte16th >= DateSerial(Year(dte16th), 3, 1) And _
   dte16th <= DateSerial(Year(dte16th), 9, 30) Then
     Me![txtEligible] = DateSerial(Year(dte16th), 5, 31)
Else
  If dte16th >= DateSerial(Year(dte16th), 10, 1) And _
     dte16th <= DateSerial(Year(dte16th), 12, 31) Then
       Me![txtEligible] = DateSerial(Year(dte16th), 12, 31)
  Else
    If dte16th >= DateSerial(Year(dte16th), 1, 1) And _
      dte16th < DateSerial(Year(dte16th), 3, 1) Then
      Me![txtEligible] = DateSerial(Year(dte16th) - 1, 12, 31)
    End If
  End If
End If
End Sub

[JacD]

Thanks. Looks much easier to read. That's what happens when you are more of a letter writer than a Code writer, it's hard not to left align everything!

txtEligible is not 'Bound' to any underlying Field, namely it has no Control Source.

Still puzzling how to overcome this. Had hoped that txtEligible would update in all records depending on the DOB of each record.

[ADezii]

Still puzzling how to overcome this. Had hoped that txtEligible would update in all records depending on the DOB of each record

Keep in mind that you would not be updating txtEligible, but the Field to which it is Bound. If you have a Field in tblPupils named [Eligible_Date] that you wish to Update based on a Field named [DOB], you would need an Update Query.