Select Date - Change background colour

[BettyWho]

Hi

I'm wondering if anyone can help me I've tried various codes to try and get a validation to work.

Basically what I want to do is change the background colour of a form based on the date in a field. The date in the field is based on the date +18 years, I'm trying to highlight a page if the person identified is under 18 and then a secondary iselse based on another box being ticked and a third elseif if both conditions are met and failing all that a default (no colour).

This is what I have for the current change on the tick box

Private Sub Form_Current()
If [Forms]![Client Demographics]![Alert] = True Then

[Forms]![Client Demographics].Detail.BackColor = vbRed

Else

[Forms]![Client Demographics].Detail.BackColor = vbWhite

End If

End Sub

This is what I tried for the date and Alert conditions:-

Private Sub Form_Current()
If [Forms]![Client Demographics]![Alert] = True Then

[Forms]![Client Demographics].Detail.BackColor = vbRed


ElseIf

[Forms]![Client Demographics]![DOB] =>Date() and <Date()-6570 Then

[Forms]![Client Demographics].Detail.BackColor = vbYellow

Else

[Forms]![Client Demographics].Detail.BackColor = vbWhite

End If

End Sub

I can't get the date part to work and it is frustrating me a bit :banghead:

Any help you can shed on my lack of experience would be awesome.

Many thanks in advance

​

 

[Isskint]

Hi BettyWho

The first thing i notice is on the line of code;

[Forms]![Client Demographics]![DOB] =>Date() and <Date()-6570 Then

You have not set the expression correctly. in multiple condition IF() statemnet you need to include the data source for each condition, so

[Forms]![Client Demographics]![DOB] =>Date() and [COLOR="Red"][Forms]![Client Demographics]![DOB][/COLOR] <Date()-6570 Then

The second thing is what happens if [Forms]![Client Demographics]![Alert] = True AND [Forms]![Client Demographics]![DOB] =>Date() and [Forms]![Client Demographics]![DOB] <Date()-6570. The structure of your nested if does not allow for this.
Thirdly the use of [forms]. if the code is on the form you want to set the colour on, just use Me.

I think my code for this would be something like the following (not tested)

Me.Detail.BackColor = vbWhite 'Default colour
If Me.Alert = True Then
    If Me.DOB >= Date And Me.DOB < Date - 6570 Then
        Me.Detail.BackColor = vbYellow 'alert true and DOB condition true
    Else
        Me.Detail.BackColor = vbWhite 'alert true and DOB condition false
    End If
Else
    If Me.DOB >= Date And Me.DOB < Date - 6570 Then
        Me.Detail.BackColor = vbYellow 'alert false and DOB condition true
    Else
        Me.Detail.BackColor = vbWhite 'alert false and DOB condition false
    End If
End If

 

[BettyWho]

Hi

Thanks for your response, The function for the alert is working (as it was which is awesome) however the date function is not working, Have I missed something in the calculation? I've done the 6570 on number of days before the date to give the cut off.. Is this correct?

I have also altered the colour to be RGB(255, 102, 0) for an orange colour. Does that work?

 

[Isskint]

OK, so we just need to review the date 'function'.

[Forms]![Client Demographics]![DOB] =>Date() and <Date()-6570 (or [Forms]![Client Demographics]![DOB] =>Date() and [Forms]![Client Demographics]![DOB]<Date()-6570) is asking if [DOB] equal to or greater the current date and < current date - 6570 days. The response to which is always going to be no (unless you have DOB from the future**unless DOB is date of birthday not Date Of Birth??). Is this supposed to identify DOB less than 18 years ago? if so then try this in place of your coding.

Dim intAge

intAge = DateDiff("yyyy", [DOB], Date) 'calculate age in years

If Date < DateSerial(Year(Date), Month([DOB]), Day([DOB])) Then intAge = intAge - 1  'check if birthdate not reached this year
        
If intAge < 18 Then
    Me.Detail.BackColor = ???'younger than 18
Else
    Me.Detail.BackColor = ???'older than 18
End If

 

[moke123]

why not calculate the age and use that

Public Function AgeYears(ByVal datBirthDate As Date) As Integer
  ' Comments: Returns the age in years
  ' Params  : datBirthDate    Date to check
  ' Returns : Number of years
  ' Source  : Total Visual SourceBook

  On Error GoTo Proc_Err

  Dim intYears As Integer

  intYears = Year(Now) - Year(datBirthDate)

  If DateSerial(Year(Now), Month(datBirthDate), Day(datBirthDate)) > Now Then
   ' Subtract a year if birthday hasn't arrived this year
    intYears = intYears - 1
  End If

  AgeYears = intYears

Proc_Exit:
  Exit Function

Proc_Err:
  MsgBox "Error: " & Err.Number & ". " & Err.Description, , "modDateTime.AgeYears"
  Resume Proc_Exit
End Function

 

[BettyWho]

OK, so we just need to review the date 'function'.

Dim intAge

intAge = DateDiff("yyyy", [DOB], Date) 'calculate age in years

If Date < DateSerial(Year(Date), Month([DOB]), Day([DOB])) Then intAge = intAge - 1  'check if birthdate not reached this year
        
If intAge < 18 Then
    Me.Detail.BackColor = ???'younger than 18
Else
    Me.Detail.BackColor = ???'older than 18
End If

Ok So I tried this and it is returning a null value..

Is it just me or have I done something wrong?

I even tried


If Date < DateSerial(Year([DOB]), Month([DOB]), Day([DOB])) Then
incase it was meant to be DOB not date but it is still returning a Null Error for the date part I placed colours in the ??? just incase you were going to say that was what the issue was.

Thoughts? I'm incredibly lost

 

[Isskint]

I just noticed i did not declare the variable type of intAge, so change that to
Dim intAge as Integer

DateSerial(Year(Date), Month([DOB]), Day([DOB])) is correct as you want to return the value of the day this year that the birthday is on.

OK, lets put in some simple checks. Put a breakpoint on intAge = DateDiff... (just click the vertical border next to the code line). When the code reaches that it will stop and you can check the value of DOB by hovering the mouse over it. Does that return a date?
Press F8 so the code advances and calculates intAge. Check the value of intAge, again by hovering the mouse over it. Does the value look right?

Press F5 to allow the code to finish.

 

[BettyWho]

Hi

It is still returning a Null value.. I have no idea what I have missed :|

This is the code I have

Private Sub Form_Current()
Dim intAge As Integer

intAge = DateDiff("yyyy", [DOB], Date) 'calculate age in years

If DateSerial(Year(Date), Month([DOB]), Day([DOB])) Then intAge = intAge - 1 'check if birthdate not reached this year

If intAge < 18 Then
Me.Detail.BackColor = vbYellow 'younger than 18
Else
Me.Detail.BackColor = vbGreen 'older than 18

End If

End Sub

Is that correct?

 

[moke123]

PMfji,

you have

If DateSerial(Year(Date), Month([DOB]), Day([DOB])) Then intAge = intAge - 1 'check if birthdate not reached this year

your missing - If Date <

If Date < DateSerial(Year(Date), Month([DOB]), Day([DOB])) Then intAge = intAge - 1  'check if birthdate not reached this year

 

[BettyWho]

Alright I'm still lost

It is returning a null value on the highlighted line. I can't see where I have gone wrong (using the solution provided by Isskint and a bit of research). :banghead: this is the last piece in a very frustrating database if anyone can see anything obvious I'd love your help. Thanks to Isskint and Moke123

Private Sub Form_Current()
Dim intAge As Integer

intAge = DateDiff("yyyy", [DOB], Date) 'calculate age in years

If Date < DateSerial(Year(Date), Month([DOB]), Day([DOB])) Then intAge = intAge - 1 'check if birthdate not reached this year

If intAge < 18 Then
Me.Detail.BackColor = vbYellow 'younger than 18
Else
Me.Detail.BackColor = vbGreen 'older than 18

End If

End Sub

 

[BettyWho]

Ok I'm no longer lost *cheer*

But every so often it returns the null value error again and it appears this is now caused by having no date of birth entered. Is there anyway validate a DOB which is blank and have the code still run ignoring the fact there is no DOB? Almost skip to the risk alert sectionif there is no DOB?
Hopefully that makes no sense otherwise I will try explaining it better.

Thanks in advance

 

[moke123]

how about wrapping the [DOB] with nz()
nz([DOB],Date)

 

[moke123]

just to be complete, you'll have to wrap all the instances of [DOB] with NZ()
i believe that will give you the results you want.
intAge will resolve to 0 if DOB is null.

Dim intAge As Integer

intAge = DateDiff("yyyy", Nz([DOB], Date), Date)

If Date < DateSerial(Year(Date), Month(Nz([DOB], Date)), Day(Nz([DOB], Date))) Then intAge = intAge - 1 'check if birthdate not reached this year

If intAge < 18 Then
Me.Detail.BackColor = vbYellow 'younger than 18
Else
Me.Detail.BackColor = vbGreen 'older than 18
End if

 

[BettyWho]

Moke123

So I tried the Nz wrap and it works however everything > 18 or NZ changes colour. What is the best way to prevent this? Should I use a default colour or should I add in a if Nz statement?

Many thanks for your assistance I feel like I'm feeling in the dark not having done anything like this before.

 

[moke123]

i'm not sure i get the question.
your code has 2 choices with the if/then statement.
if the person is under 18 then the detail section of your form is yellow.
if the person is over 18 then the detail section of your form is green.

Nz ( variant, [ value_if_null ] )

so in your situation, intAge = DateDiff("yyyy", Nz([DOB], Date), Date), you are
saying intAge = the difference in years between the date of birth and the current date. So if the DOB field or control is null the NZ() substitutes the current date for the null value which translates into the difference between todays date in years and todays date which is 0. (the difference between 2016 and 2016)

Do you want a different result if the DOB field is null and you dont want it counted as being under 18?
you could always add in more conditions

If intAge = 0 And IsNull([DOB]) Then
Me.Detail.BackColor = vbBlue
ElseIf intAge = 0 And Not IsNull([DOB]) Then
Me.Detail.BackColor = vbRed
ElseIf intAge < 18 Then
Me.Detail.BackColor = vbYellow 'younger than 18
Else
Me.Detail.BackColor = vbGreen 'older than 18
End If

 

[BettyWho]

Thanks Moke123


It's starting to make a little more sense. One final question and I'll figure out the rest. Using your solution above/below how do I add multiple conditions based on for example the birth date and whether a secondary condition is met ie a date of birth and a check box on whether they like balloons? (Yes this is strictly an example but I figure if I have an example to give you I can figure out the rest once I know the conditions [ I'm meeting with the client Thursday and they have already indicated they want to cross check with more colours and such)

Thanking you in advance.

 

[moke123]

it really just matters what you want to do.
you can have as many If/then statements you want and use different events to trigger them.

for instance if you wanted a label to have a red color if the checkbox for balloons is checked you'd have something like

if me.chkBalloons = true then
me.somelabel.forecolor= vbred
end if

HTH

 

[BettyWho]

it really just matters what you want to do.
you can have as many If/then statements you want and use different events to trigger them.

for instance if you wanted a label to have a red color if the checkbox for balloons is checked you'd have something like

if me.chkBalloons = true then
me.somelabel.forecolor= vbred
end if

HTH

Moke123 - Thanks for that - I understand that concept, I'm asking about the date integer specifically, I tried a different way to incorporate the date solution above plus a text box and i can't make it work, its the first time I've ever tried something like this. I would be so grateful if you could assist you've been fantastic in your advice already!!

Basically what I am trying to achieve and this is what i stumbled on to begin with is I am trying to trigger a statement based on a birthday being over or under 18 and whether or not a check box is ticked, I was able to successfully do them both separately but am having issues combining them. You were able to help me clean up the date issue but I'm still in the dark on how to make it work together.. Does that make sense?
Many Many Many thanks in advance.

 

[moke123]

Does that make sense?

yes, but i cant see it. Why dont you post what you have so i can see it and give me a narrative of the logic.

 

[BettyWho]

yes, but i cant see it. Why dont you post what you have so i can see it and give me a narrative of the logic.

Alrighty

So I'm trying to base an a colour change based on the below variables.

One being birthdate and the second if they check a tick box.

This is sort of what I started with and Isskint suggested how to clean it up, which was awesome

Me.Detail.BackColor = vbWhite 'Default colour If Me.Alert = True Then If Me.DOB >= Date And Me.DOB < Date - 6570 Then Me.Detail.BackColor = vbYellow 'alert true and DOB condition true Else Me.Detail.BackColor = vbWhite 'alert true and DOB condition false End If Else If Me.DOB >= Date And Me.DOB < Date - 6570 Then Me.Detail.BackColor = vbYellow 'alert false and DOB condition true Else Me.Detail.BackColor = vbWhite 'alert false and DOB condition false End If End If



However the me.DOB < Date - 6570 was not working and you helped me clean up the Integer String (also awesome) to be below:-


Private Sub Form_Current()
Dim intAge As Integer

intAge = DateDiff("yyyy", [DOB], Date) 'calculate age in years

If Date < DateSerial(Year(Date), Month([DOB]), Day([DOB])) Then intAge = intAge - 1 'check if birthdate not reached this year

If intAge < 18 Then
Me.Detail.BackColor = vbYellow 'younger than 18
Else
Me.Detail.BackColor = vbGreen 'older than 18

End If

End Sub



Now I have the two parts I just have no idea how to join the two and I've been trying If / And / Then / Else functions. I haven't don't any coding like this before I normally using And / If statements very simply. I'm a little out of my comfort zone and its all starting to look the same!!! Any help you can offer is greatly appreciated.

Thanks in advance