Autofill Field

[Brondeau]

I am currently having an issue with autfilling a field in one form from data that is supplied in a master data sheet. Below is the code for the form that I am trying to fix:

""Option Compare Database
Private Pass As String
Private Sub Age_Click()
End Sub
Private Sub APFT_PASS_FAIL_Enter()
If APFT_PASS_FAIL = "Diagnostic" _
Then
Else

Select Case Pass
Case DLookup("[Admin Password]", "[Company Info]")
If (PU_SCORE + SU_SCORE + RU_SCORE = 0) Then APFT_PASS_FAIL = "Not Tested": Exit Sub
Select Case PU_SCORE
Case Is >= 60: APFT_PASS_FAIL = "Passed"
Case 0 To 50: APFT_PASS_FAIL = "Failed": Exit Sub
Case Else: APFT_PASS_FAIL = "Not Tested"
End Select
Select Case SU_SCORE
Case Is >= 60: APFT_PASS_FAIL = "Passed"
Case 0 To 59: APFT_PASS_FAIL = "Failed": Exit Sub
Case Else: APFT_PASS_FAIL = "Not Tested"
End Select
Select Case RU_SCORE
Case Is >= 60: APFT_PASS_FAIL = "Passed"
Case 0 To 59: APFT_PASS_FAIL = "Failed": Exit Sub
Case Else: APFT_PASS_FAIL = "Not Tested"
End Select
Case Else
End Select
End If

End Sub

Private Sub APFT_Score_Enter()
On Error GoTo Err_APFT_Score_Enter
Select Case Pass
Case DLookup("[Admin Password]", "[Company Info]")
APFT_Score = PU_SCORE + SU_SCORE + RU_SCORE

Err_APFT_Score_Enter:
Case Else
End Select
Exit Sub
End Sub
Private Sub Form_Load()
Me.OrderBy = "[PT SCORES].[EXPR1]"
End Sub

Private Sub Form_Open(Cancel As Integer)
Pass = InputBox("To Unlock The Records Enter The Admin Password")
Select Case Pass
Case DLookup("[Admin Password]", "[Company Info]")
Me.AllowEdits = True
Case Else
Me.AllowEdits = False
End Select

End Sub

Private Sub PU_SCORE_Enter()
On Error GoTo Err_PU_SCORE_Enter
Select Case Pass
Case DLookup("[Admin Password]", "[Company Info]")
PU_SCORE = Pushup_score(PU_RAW, Gender, Age)
Err_PU_SCORE_Enter:
Case Else
End Select
Exit Sub
End Sub
Private Sub SU_SCORE_Enter()
On Error GoTo Err_SU_SCORE_Enter
Select Case Pass
Case DLookup("[Admin Password]", "[Company Info]")
SU_SCORE = Situp_score(SU_RAW, Age)
Case Else
End Select
Err_SU_SCORE_Enter:

Exit Sub
End Sub
Private Sub RU_SCORE_Enter()
On Error GoTo Err_RU_SCORE_Enter
Select Case Pass
Case DLookup("[Admin Password]", "[Company Info]")
Select Case RU_TIME
Case "Walk"
RU_SCORE = (PU_SCORE + SU_SCORE) / 2
Case "Bike"
RU_SCORE = (PU_SCORE + SU_SCORE) / 2
Case "Swim"
RU_SCORE = (PU_SCORE + SU_SCORE) / 2
Case Else
RU_SCORE = Run_score(RU_TIME, Gender, Age)
End Select
Case Else
End Select
Err_RU_SCORE_Enter:

Exit Sub
End Sub
Private Sub Command31_Click()
On Error GoTo Err_Command31_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = "PT Totals"
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Command31_Click:
Exit Sub
Err_Command31_Click:
MsgBox Err.Description
Resume Exit_Command31_Click

End Sub
Private Sub Command32_Click()
On Error GoTo Err_Command32_Click
Dim stDocName As String
Dim stLinkCriteria As String
stDocName = "PT Cards"
DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Command32_Click:
Exit Sub
Err_Command32_Click:
MsgBox Err.Description
Resume Exit_Command32_Click

End Sub
Private Sub Text47_DblClick(Cancel As Integer)
[Weight Go NoGo] = Not [Weight Go NoGo]
Text47.Requery
End Sub
Private Sub Text48_DblClick(Cancel As Integer)
[Body Fat Go NoGo] = Not [Body Fat Go NoGo]
Text48.Requery
End Sub
""

This code comes from the OnLoad command. What I want it to do is automatically pull the "AGE" from another datasheet within the database instead of having to double click each individual age for each person to update the current age for that person. Any help is appreciated. Thank you

 

[PaulO]

my goodness that's a lot of code for what could perhaps be replaced by a combination of dlookup formula and a form field calculation to display current age ... ?

 

[Brondeau]

That is all the code for one whole sheet. My fault. I know the main part of interest is the following:


Private Sub Age_Click()
End Sub
Private Sub Age_DblClick(Cancel As Integer)

On Error GoTo Err_Age_Enter
Select Case Pass
Case DLookup("[Admin Password]", "[Company Info]")
If MsgBox("DO YOU WANT TO AUTO UPDATE AGE", vbYesNo) = vbYes Then
Age = DateDiff("yyyy", [DOB], Now()) + Int(Format(Now(), "mmdd") < Format([DOB], "mmdd"))
Else

End If
Case Else
End Select
Err_Age_Enter:
Exit Sub
End Sub


I like the DblClick feature to force an "Age" update but at the same time I also looking to make the form automatically update the age field upon opening that form.