Calculated Form Field (2000/All)

Topic

New Reply

I have a field that calculates age by subtracting DOB from the computer date and displaying the result like so: ‘ 10.3 ‘ =IIf(IsNull([DOB]),””,Age([DOB]) & “.” & AgeMonths([DOB])). This is derived from an Age Function written by unknown person. The field is used to display the age in years and months with the period as a separator.

Another field has a Reading Age that is typed into the form in the same format. (ie. 9.5 is nine years and five months.)

In a third field I would like to show the difference in the following format :+ or – 1.2 being a Reading Age that is +1.2 if the Reading Age is 1 year and 2 months ahead of the chronological age.

I must stay with the 9.5 format as that is preferred by the user.

Should I change the field back to a number? Any suggestions on this one please?

Leigh

Reply | Quote

Replies

You could create the following procedure in the form module. You must replace txtAge, txtReadingAge and txtAgeDiff by the names of your text boxes.

Private Sub CalcDiff()
Dim intPos1 As Integer
Dim intYr1 As Integer
Dim intMn1 As Integer
Dim intAg1 As Integer
Dim intPos2 As Integer
Dim intYr2 As Integer
Dim intMn2 As Integer
Dim intAg2 As Integer
Dim intDif As Integer
Dim strRes As String

On Error GoTo ErrHandler

If Not IsNull(Me.txtAge) And Not IsNull(Me.txtReadingAge) Then
intPos1 = InStr(Me.txtAge, “.”)
intYr1 = CInt(Left(Me.txtAge, intPos1 – 1))
intMn1 = CInt(Mid(Me.txtAge, intPos1 + 1))
intAg1 = 12 * intYr1 + intMn1
intPos2 = InStr(Me.txtReadingAge, “.”)
intYr2 = CInt(Left(Me.txtReadingAge, intPos2 – 1))
intMn2 = CInt(Mid(Me.txtReadingAge, intPos2 + 1))
intAg2 = 12 * intYr2 + intMn2
intDif = intAg2 – intAg1
If intDif < 0 Then
strRes = "-"
intDif = -intDif
End If
strRes = strRes & (intDif 12) & "." & (intDif Mod 12)
Me.txtAgeDiff = strRes
End If

Exit Sub

ErrHandler:
Me.txtAgeDiff = Null
MsgBox Err.Description, vbExclamation
End Sub

Call it in the After Update event of the text boxes that contribute to the result, probably the DOB text box and txtReadingAge, for example:

Private Sub txtReadingAge_AfterUpdate()
CalcDiff
End Sub

Reply | Quote

Thanks Hans, you have hit the nail on the head – again.

Now, just a small question about code design.

There are actually 6 reading age and 6 spelling age text boxes that I will be using the code for. Therefore I need to run the code past each (txtY2RA through to txtY7RA – being text boxes for Years 2 to 7 Reading Age and likewise for Spelling Age data).

Would I be better to use For each…Next modification to the code to iterate through each or would you suggest something else?

Many thanks as usual
Leigh

Reply | Quote

In the first place, wouldn’t it be more efficient to use a continuous form, with a separate record for each age? That would reduce the number of text boxes needed.

If you prefer to keep the separate text boxes, you could do something like this, using the same control names as in my previous example:

Private Sub CalcDiff(intIndex As Integer)
Dim intPos1 As Integer
Dim intYr1 As Integer
Dim intMn1 As Integer
Dim intAg1 As Integer
Dim intPos2 As Integer
Dim intYr2 As Integer
Dim intMn2 As Integer
Dim intAg2 As Integer
Dim intDif As Integer
Dim strRes As String

On Error GoTo ErrHandler

If Not IsNull(Me.Controls(“txtAge” & intIndex)) And _
Not IsNull(MeControls(“txtReadingAge” & intIndex)) Then
intPos1 = InStr(Me.Controls(“txtAge” & intIndex), “.”)
intYr1 = CInt(Left(Me.Controls(“txtAge” & intIndex), intPos1 – 1))
intMn1 = CInt(Mid(Me.Controls(“txtAge” & intIndex), intPos1 + 1))
intAg1 = 12 * intYr1 + intMn1
intPos2 = InStr(Me.Controls(“txtReadingAge” & intIndex), “.”)
intYr2 = CInt(Left(Me.Controls(“txtReadingAge” & intIndex), intPos2 – 1))
intMn2 = CInt(Mid(Me.Controls(“txtReadingAge” & intIndex), intPos2 + 1))
intAg2 = 12 * intYr2 + intMn2
intDif = intAg2 – intAg1
If intDif < 0 Then
strRes = "-"
intDif = -intDif
End If
strRes = strRes & (intDif 12) & "." & (intDif Mod 12)
Me.Controls("txtAgeDiff" & intIndex) = strRes
End If

Exit Sub

ErrHandler:
Me.Controls("txtAgeDiff" & intIndex) = Null
MsgBox Err.Description, vbExclamation
End Sub

Use this procedure, with the extra argument, like this:

Private Sub txtReadingAge1_AfterUpdate()
CalcDiff 1
End Sub

Private Sub txtReadingAge2_AfterUpdate()
CalcDiff 2
End Sub

etc.

Reply | Quote

Thanks, and yes, it would have been better to display a continuous form but the layout of the existing form has one student’s records for each school year displayed and by choosing the year from a dropdown all other years’ details are made not visible.

I must admit that I have never come across the use of intIndex but I welcome the opportunities it offers.

Now to play…

Reply | Quote

intIndex does not have an intrinsic meaning; it is just the name I gave to the argument for CalcDiff; I might just as well have used i or TheNumber.

Reply | Quote

Hans, thanks for the explanation – what I meant was that I hadn’t considered the ability to ‘step’ through a subroutine in that manner.

Reply | Quote

Hans, thanks for the explanation – what I meant was that I hadn’t considered the ability to ‘step’ through a subroutine in that manner.

Reply | Quote

intIndex does not have an intrinsic meaning; it is just the name I gave to the argument for CalcDiff; I might just as well have used i or TheNumber.

Reply | Quote

Thanks, and yes, it would have been better to display a continuous form but the layout of the existing form has one student’s records for each school year displayed and by choosing the year from a dropdown all other years’ details are made not visible.

I must admit that I have never come across the use of intIndex but I welcome the opportunities it offers.

Now to play…

Reply | Quote

In the first place, wouldn’t it be more efficient to use a continuous form, with a separate record for each age? That would reduce the number of text boxes needed.

If you prefer to keep the separate text boxes, you could do something like this, using the same control names as in my previous example:

Private Sub CalcDiff(intIndex As Integer)
Dim intPos1 As Integer
Dim intYr1 As Integer
Dim intMn1 As Integer
Dim intAg1 As Integer
Dim intPos2 As Integer
Dim intYr2 As Integer
Dim intMn2 As Integer
Dim intAg2 As Integer
Dim intDif As Integer
Dim strRes As String

On Error GoTo ErrHandler

If Not IsNull(Me.Controls(“txtAge” & intIndex)) And _
Not IsNull(MeControls(“txtReadingAge” & intIndex)) Then
intPos1 = InStr(Me.Controls(“txtAge” & intIndex), “.”)
intYr1 = CInt(Left(Me.Controls(“txtAge” & intIndex), intPos1 – 1))
intMn1 = CInt(Mid(Me.Controls(“txtAge” & intIndex), intPos1 + 1))
intAg1 = 12 * intYr1 + intMn1
intPos2 = InStr(Me.Controls(“txtReadingAge” & intIndex), “.”)
intYr2 = CInt(Left(Me.Controls(“txtReadingAge” & intIndex), intPos2 – 1))
intMn2 = CInt(Mid(Me.Controls(“txtReadingAge” & intIndex), intPos2 + 1))
intAg2 = 12 * intYr2 + intMn2
intDif = intAg2 – intAg1
If intDif < 0 Then
strRes = "-"
intDif = -intDif
End If
strRes = strRes & (intDif 12) & "." & (intDif Mod 12)
Me.Controls("txtAgeDiff" & intIndex) = strRes
End If

Exit Sub

ErrHandler:
Me.Controls("txtAgeDiff" & intIndex) = Null
MsgBox Err.Description, vbExclamation
End Sub

Use this procedure, with the extra argument, like this:

Private Sub txtReadingAge1_AfterUpdate()
CalcDiff 1
End Sub

Private Sub txtReadingAge2_AfterUpdate()
CalcDiff 2
End Sub

etc.

Reply | Quote

Thanks Hans, you have hit the nail on the head – again.

Now, just a small question about code design.

There are actually 6 reading age and 6 spelling age text boxes that I will be using the code for. Therefore I need to run the code past each (txtY2RA through to txtY7RA – being text boxes for Years 2 to 7 Reading Age and likewise for Spelling Age data).

Would I be better to use For each…Next modification to the code to iterate through each or would you suggest something else?

Many thanks as usual
Leigh

Reply | Quote

You could create the following procedure in the form module. You must replace txtAge, txtReadingAge and txtAgeDiff by the names of your text boxes.

Private Sub CalcDiff()
Dim intPos1 As Integer
Dim intYr1 As Integer
Dim intMn1 As Integer
Dim intAg1 As Integer
Dim intPos2 As Integer
Dim intYr2 As Integer
Dim intMn2 As Integer
Dim intAg2 As Integer
Dim intDif As Integer
Dim strRes As String

On Error GoTo ErrHandler

If Not IsNull(Me.txtAge) And Not IsNull(Me.txtReadingAge) Then
intPos1 = InStr(Me.txtAge, “.”)
intYr1 = CInt(Left(Me.txtAge, intPos1 – 1))
intMn1 = CInt(Mid(Me.txtAge, intPos1 + 1))
intAg1 = 12 * intYr1 + intMn1
intPos2 = InStr(Me.txtReadingAge, “.”)
intYr2 = CInt(Left(Me.txtReadingAge, intPos2 – 1))
intMn2 = CInt(Mid(Me.txtReadingAge, intPos2 + 1))
intAg2 = 12 * intYr2 + intMn2
intDif = intAg2 – intAg1
If intDif < 0 Then
strRes = "-"
intDif = -intDif
End If
strRes = strRes & (intDif 12) & "." & (intDif Mod 12)
Me.txtAgeDiff = strRes
End If

Exit Sub

ErrHandler:
Me.txtAgeDiff = Null
MsgBox Err.Description, vbExclamation
End Sub

Call it in the After Update event of the text boxes that contribute to the result, probably the DOB text box and txtReadingAge, for example:

Private Sub txtReadingAge_AfterUpdate()
CalcDiff
End Sub

Reply | Quote