Combo Box requires you to select a value twice in order to register the selection

[Paul]

I've got a combo box in a subform datasheet that won't take the first
selection when you're using the mouse. This is a combo box that is bound to
one of three fields in a three field primary key.

When you select by clicking on a value in the dropped box, the combo box
goes into edit mode, and the cell, along with the entire row, is blank. If
you then click the down arrow a second time and make a selection, the row
populates with the new record. There is code in both the Before and After
Update events, and I've even commented out both events to see if something
in there was causing this strange behavior, but it still remained in Edit
mode after the first selection.

If you type values from the keyboard, it behaves normally. That is, once
you type any set of letters that the control recognizes and then press Tab
or Enter, the record populates normally. It only seems to be when you try
to select a record with the mouse that it requires a second selection.

I also noticed that when you make that second selection, you can click on a
different value than you selected the first time, and it will populate the
row with the value you selected the second time.

Any idea what could be causing this strange behavior in the combo box, and
what I can do to restore it to normal behavior, so the user selects a record
with the first click?

Thanks in advance,

Paul

 

[Ken Snell \(MVP\)]

Are you running code on the subform control's OnEnter event? (The subform
control is the main form's control that actually holds the subform).

Are you running code on the subform form's OnCurrent event?

It would be good if you posted all the code so that we can see what is
happening.

--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/

 

[Paul]

Thanks for taking a look at this, Ken and RG.

I think I may have found the problem, thanks to Ken's suggestion that I
forward the code.

As I was preparing to do so, I noticed that the name of the offending combo
box was "ContactID," the same name as the underlying foreign key field.
Think that I might get chided for using amateurish names for my controls, I
renamed it to "cboContactID," and so far it seems to be working ok.

Could that have been the cause of the problem?

(It's not a combo box used to go to different records in the subform, it's a
bound control used to either change an existing Contact or to add a new
Contact to the subform).

Paul


Here are the object names:
main form - frmProjects
subform control - frmProjectContactsSub
subform - frmProjectContactsSub
subform combo box - cboContactID (formerly "ContactID" - this is the
control I was having the trouble with)

Here is the code in case it is of any interest:

Option Explicit
Option Compare Database

Private Sub cboContactID_AfterUpdate()
On Error GoTo ErrorTrap

'Add the Contact Type based on the value in the Contacts table.
Me!cboContactTypeID = DLookup("ContactTypeID", "tblContacts", "ContactID
= " & ContactID)

'Make sure there's only 1 of each for Agency Contact, REO and Planner
Call cboContactTypeID_AfterUpdate

'Save the record
'DoCmd.RunCommand acCmdSave 'this doesn't seem to have any effect

Exit Sub
ErrorTrap:
MsgBox "The following error has occurred: " & vbCr & vbCr & _
Err.Number & " - " & Err.Description & vbCr & vbCr & _
"Press 'Alt + Print Scrn' to copy this notice into an email message to
the database administrator.", vbOKOnly, "Error Notice"
Resume Next
End Sub

Private Sub cboContactID_BeforeUpdate(Cancel As Integer)
On Error GoTo ErrorTrap

'make sure a contact hasn't been entered more than once for a given project
If DCount("*", "tblProjectContact", "ContactID = " & Me!cboContactID & "
And ProjectID = " & Me!ProjectID) > 0 Then
MsgBox "That contact that has already been added to this project.",
vbOKOnly, "Contact Already Exists."
Cancel = True
Me.Undo
Exit Sub
End If

Exit Sub
ErrorTrap:
MsgBox "The following error has occurred: " & vbCr & vbCr & _
Err.Number & " - " & Err.Description & vbCr & vbCr & _
"Press 'Alt + Print Scrn' to copy this notice into an email message to
the database administrator.", vbOKOnly, "Error Notice"
Resume Next
End Sub

Private Sub cboContactID_DblClick(Cancel As Integer)
On Error GoTo ErrorTrap

Dim stDocName As String
Dim stLinkCriteria As String

If Len(Nz(Me.ActiveControl)) > 0 Then
stDocName = "frmContacts"
stLinkCriteria = "[ContactID]=" & Me![ContactID]
DoCmd.OpenForm stDocName, , , stLinkCriteria

'Hide combo box, display "Select another contact" label to display combo box
Forms!frmContacts!cboSelectContact.Visible = False
Forms!frmContacts!lbl_Enable_cboSelectContact.Visible = True

End If

Exit Sub

ErrorTrap:
MsgBox "The following error has occurred: " & vbCr & vbCr & _
Err.Number & " - " & Err.Description & vbCr & vbCr & _
"Press 'Alt + Print Scrn' to copy this notice into an email message to
the database administrator.", vbOKOnly, "Error Notice"
Resume Next
End Sub

Private Sub cboContactID_NotInList(NewData As String, Response As Integer)
On Error GoTo ErrorTrap

Response = acDataErrContinue

If MsgBox("The name you entered is not in the Contact list. Would you
like to add it?", vbYesNo, "Contact not in list.") = vbYes Then
Me.Undo
DoCmd.OpenForm "frm_Name_lookup"
Else
Me.Undo
Forms!frmProjects!txtFocusTrap.SetFocus
End If

Exit Sub

ErrorTrap:
MsgBox "The following error has occurred: " & vbCr & vbCr & _
Err.Number & " - " & Err.Description & vbCr & vbCr & _
"Press 'Alt + Print Scrn' to copy this notice into an email message to
the database administrator.", vbOKOnly, "Error Notice"
Resume Next
End Sub

Private Sub cboContactTypeID_AfterUpdate()
'Make sure there's only 1 of each for Agency Contact, REO and Planner
'If you're setting a Contact Type to Agency Rep,
' reset any preexisting Agency Contact to Agency Rep
If Me!cboContactTypeID = 22 Then
Forms!frmProjects!cboAgencyContact = Me!cboContactID 'for Agency
Contacts only
DoCmd.SetWarnings False
DoCmd.OpenQuery ("qry_update_Agency_Reps_frmProjects") 'resets all
Agency Contacts to an Agency Reps
DoCmd.SetWarnings True
Me!cboContactTypeID = 22 'reset the current record to an Agency
Contact
Me.Requery
End If
' reset any preexisting REOs to Team Member
If Me!cboContactTypeID = 2 Then
DoCmd.SetWarnings False
DoCmd.OpenQuery ("qry_update_REOs_frmProjects") 'reset all REOs to
a Team Members
DoCmd.SetWarnings True
Me!cboContactTypeID = 2 'reset the current record to an REO
Me.Requery
End If
' reset any preexisting Planners to Team Member
If Me!cboContactTypeID = 1 Then
DoCmd.SetWarnings False
DoCmd.OpenQuery ("qry_update_Planners_frmProjects") 'reset all
Planners to a Team Members
DoCmd.SetWarnings True
Me!cboContactTypeID = 1 'reset the current record to a Planner
Me.Requery
End If
End Sub

Private Sub cboContactTypeID_Enter()
If Len(Nz(Me!cboContactID)) = 0 Then Me!cboContactID.SetFocus
End Sub

Private Sub Email_Enter()
If Len(Nz(Me!cboContactID)) = 0 Then Me!cboContactID.SetFocus
End Sub

Private Sub Phone_Enter()
If Len(Nz(Me!cboContactID)) = 0 Then Me!cboContactID.SetFocus
End Sub

 

[Ken Snell \(MVP\)]

If this line of code in the BeforeUpdate event of the cboContactID combobox:

If DCount("*", "tblProjectContact", "ContactID = " & Me!cboContactID & "
And ProjectID = " & Me!ProjectID) > 0 Then


used to be this:

If DCount("*", "tblProjectContact", "ContactID = " & Me!ContactID & "
And ProjectID = " & Me!ProjectID) > 0 Then


then it's possible that ACCESS was confused about the value of control or
field, though the use of ! should point to ContactID control, not field.
Otherwise, I don't see anything obvious in your current code that would have
caused the behavior. You didn't answer my question about whether you're
running any events on the subform control itself? And you didn't post any
code from the main form's module.


I also think that this line of code in the cboContactID_DblClick

stLinkCriteria = "[ContactID]=" & Me![ContactID]

should be changed to

stLinkCriteria = "[ContactID]=" & Me![cboContactID]

--

Ken Snell
<MS ACCESS MVP>
http://www.accessmvp.com/KDSnell/

Thanks for taking a look at this, Ken and RG.

I think I may have found the problem, thanks to Ken's suggestion that I
forward the code.

As I was preparing to do so, I noticed that the name of the offending
combo box was "ContactID," the same name as the underlying foreign key
field. Think that I might get chided for using amateurish names for my
controls, I renamed it to "cboContactID," and so far it seems to be
working ok.

Could that have been the cause of the problem?

(It's not a combo box used to go to different records in the subform, it's
a bound control used to either change an existing Contact or to add a new
Contact to the subform).

Paul


Here are the object names:
main form - frmProjects
subform control - frmProjectContactsSub
subform - frmProjectContactsSub
subform combo box - cboContactID (formerly "ContactID" - this is the
control I was having the trouble with)

Here is the code in case it is of any interest:

Option Explicit
Option Compare Database

Private Sub cboContactID_AfterUpdate()
On Error GoTo ErrorTrap

'Add the Contact Type based on the value in the Contacts table.
Me!cboContactTypeID = DLookup("ContactTypeID", "tblContacts",
"ContactID = " & ContactID)

'Make sure there's only 1 of each for Agency Contact, REO and Planner
Call cboContactTypeID_AfterUpdate

'Save the record
'DoCmd.RunCommand acCmdSave 'this doesn't seem to have any effect

Exit Sub
ErrorTrap:
MsgBox "The following error has occurred: " & vbCr & vbCr & _
Err.Number & " - " & Err.Description & vbCr & vbCr & _
"Press 'Alt + Print Scrn' to copy this notice into an email message to
the database administrator.", vbOKOnly, "Error Notice"
Resume Next
End Sub

Private Sub cboContactID_BeforeUpdate(Cancel As Integer)
On Error GoTo ErrorTrap

'make sure a contact hasn't been entered more than once for a given
project
If DCount("*", "tblProjectContact", "ContactID = " & Me!cboContactID & "
And ProjectID = " & Me!ProjectID) > 0 Then
MsgBox "That contact that has already been added to this project.",
vbOKOnly, "Contact Already Exists."
Cancel = True
Me.Undo
Exit Sub
End If

Exit Sub
ErrorTrap:
MsgBox "The following error has occurred: " & vbCr & vbCr & _
Err.Number & " - " & Err.Description & vbCr & vbCr & _
"Press 'Alt + Print Scrn' to copy this notice into an email message to
the database administrator.", vbOKOnly, "Error Notice"
Resume Next
End Sub

Private Sub cboContactID_DblClick(Cancel As Integer)
On Error GoTo ErrorTrap

Dim stDocName As String
Dim stLinkCriteria As String

If Len(Nz(Me.ActiveControl)) > 0 Then
stDocName = "frmContacts"
stLinkCriteria = "[ContactID]=" & Me![ContactID]
DoCmd.OpenForm stDocName, , , stLinkCriteria

'Hide combo box, display "Select another contact" label to display combo
box
Forms!frmContacts!cboSelectContact.Visible = False
Forms!frmContacts!lbl_Enable_cboSelectContact.Visible = True

End If

Exit Sub

ErrorTrap:
MsgBox "The following error has occurred: " & vbCr & vbCr & _
Err.Number & " - " & Err.Description & vbCr & vbCr & _
"Press 'Alt + Print Scrn' to copy this notice into an email message to
the database administrator.", vbOKOnly, "Error Notice"
Resume Next
End Sub

Private Sub cboContactID_NotInList(NewData As String, Response As Integer)
On Error GoTo ErrorTrap

Response = acDataErrContinue

If MsgBox("The name you entered is not in the Contact list. Would you
like to add it?", vbYesNo, "Contact not in list.") = vbYes Then
Me.Undo
DoCmd.OpenForm "frm_Name_lookup"
Else
Me.Undo
Forms!frmProjects!txtFocusTrap.SetFocus
End If

Exit Sub

ErrorTrap:
MsgBox "The following error has occurred: " & vbCr & vbCr & _
Err.Number & " - " & Err.Description & vbCr & vbCr & _
"Press 'Alt + Print Scrn' to copy this notice into an email message to
the database administrator.", vbOKOnly, "Error Notice"
Resume Next
End Sub

Private Sub cboContactTypeID_AfterUpdate()
'Make sure there's only 1 of each for Agency Contact, REO and Planner
'If you're setting a Contact Type to Agency Rep,
' reset any preexisting Agency Contact to Agency Rep
If Me!cboContactTypeID = 22 Then
Forms!frmProjects!cboAgencyContact = Me!cboContactID 'for Agency
Contacts only
DoCmd.SetWarnings False
DoCmd.OpenQuery ("qry_update_Agency_Reps_frmProjects") 'resets all
Agency Contacts to an Agency Reps
DoCmd.SetWarnings True
Me!cboContactTypeID = 22 'reset the current record to an Agency
Contact
Me.Requery
End If
' reset any preexisting REOs to Team Member
If Me!cboContactTypeID = 2 Then
DoCmd.SetWarnings False
DoCmd.OpenQuery ("qry_update_REOs_frmProjects") 'reset all REOs to
a Team Members
DoCmd.SetWarnings True
Me!cboContactTypeID = 2 'reset the current record to an REO
Me.Requery
End If
' reset any preexisting Planners to Team Member
If Me!cboContactTypeID = 1 Then
DoCmd.SetWarnings False
DoCmd.OpenQuery ("qry_update_Planners_frmProjects") 'reset all
Planners to a Team Members
DoCmd.SetWarnings True
Me!cboContactTypeID = 1 'reset the current record to a Planner
Me.Requery
End If
End Sub

Private Sub cboContactTypeID_Enter()
If Len(Nz(Me!cboContactID)) = 0 Then Me!cboContactID.SetFocus
End Sub

Private Sub Email_Enter()
If Len(Nz(Me!cboContactID)) = 0 Then Me!cboContactID.SetFocus
End Sub

Private Sub Phone_Enter()
If Len(Nz(Me!cboContactID)) = 0 Then Me!cboContactID.SetFocus
End Sub

 

[Paul]

Ken,

I'm not running code in any of the subform control's events, nor am I
running any code in the subform form's OnCurrent event. Again, thanks for
taking the time to review the code and make those suggestions.

Paul

Just in case it would be of any interest, here is the code from the Main
Form's module:

Option Explicit
Option Compare Database

Private Sub cboSelectProject_Enter()
Me.AllowEdits = True
Me!frmProjectContactsSub.Form.AllowEdits = True
Me!ctlLeases.Form.AllowEdits = True
End Sub

Private Sub cboSelectProject_AfterUpdate()
' Find the record that matches the control.
Dim rs As Object

Set rs = Me.Recordset.Clone
rs.FindFirst "[ProjectID] = " & Str(Nz(Me![cboSelectProject], 0))
If Not rs.EOF Then Me.Bookmark = rs.Bookmark

End Sub

Function authorization_check()
'Determine if the user is a member of the project and set the authorization
for form and both subforms.

'If we're just adding a new record to the form, don't run this function
If Me.RecordsetClone.RecordCount < 2 Then Exit Function

'begin authorization check
Dim db As Database
Dim rs As Recordset
Dim strSql As String
Set db = CurrentDb
strSql = "SELECT tblProject.ProjectID, tblContacts.osUserName FROM
tblProject INNER JOIN (tblContacts INNER JOIN tblProjectContact ON
tblContacts.ContactID = tblProjectContact.ContactID) ON tblProject.ProjectID
= tblProjectContact.ProjectID WHERE (tblProject.ProjectID = " &
Forms!frmProjects!txtProjectID & ") AND tblContacts.osUserName =
fosUserName();"
Set rs = db.OpenRecordset(strSql, dbOpenDynaset)
If rs.RecordCount > 0 Then
authorization_check = True
Else
authorization_check = False
End If

Me.AllowEdits = authorization_check
Me.AllowDeletions = authorization_check
Me!frmProjectContactsSub.Form.AllowEdits = authorization_check
Me!frmProjectContactsSub.Form.AllowAdditions = authorization_check
Me!frmProjectContactsSub.Form.AllowDeletions = authorization_check
Me!ctlLeases.Form.AllowEdits = authorization_check
Me!ctlLeases.Form.AllowAdditions = authorization_check
Me!ctlLeases.Form.AllowDeletions = authorization_check

'end authorization check
End Function

Private Sub City_AfterUpdate()
Me!County = DLookup("County", "tblCityZip", "City = '" & City & "'")
If Len(Nz(Me!cboAgency)) > 0 And Len(Nz(Me!City)) > 0 And
Len(Nz(Me!txtProjectID)) > 0 Then
Me!txtProjectName = Me!cboAgency & "_" & Me!City & "_" &
Me!txtProjectID
End If
Me!cboSelectProject.Requery
Me.Repaint
fRequeryAll
End Sub

Private Sub cmd_Close_without_saving_Click()
Me.Undo
DoCmd.Close
End Sub

Private Sub cmd_open_frmProjectNotes_Click()
On Error GoTo Err_cmd_open_frmProjectNotes_Click

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "frmProjectNotes"
stLinkCriteria = "[ProjectID]=" & Me![ProjectID]

If authorization_check = True Then
DoCmd.RunCommand acCmdSaveRecord
DoCmd.OpenForm stDocName, , , stLinkCriteria
Else
Me.Undo
DoCmd.OpenForm stDocName, , , stLinkCriteria, acFormReadOnly
End If

Exit_cmd_open_frmProjectNotes_Click:
Exit Sub

Err_cmd_open_frmProjectNotes_Click:
MsgBox Err.Description
Resume Exit_cmd_open_frmProjectNotes_Click

End Sub

Private Sub cmd_Save_and_Close_Click()
If authorization_check = True Then
DoCmd.RunCommand acCmdSaveRecord
Else
Me.Undo
End If
DoCmd.Close
End Sub

Private Sub cmdAddNewContact_Click()
On Error GoTo ErrorTrap

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "frm_Name_Lookup"
DoCmd.OpenForm stDocName, , , stLinkCriteria, acFormAdd

''Hide combo box and "Select another contact" label
' Forms!frmContacts!cboSelectContact.Visible = False
' Forms!frmContacts!lbl_Enable_cboSelectContact.Visible = False

Exit Sub

ErrorTrap:
MsgBox "The following error has occurred: " & vbCr & vbCr & _
Err.Number & " - " & Err.Description & vbCr & vbCr & _
"Press 'Alt + Print Scrn' to copy this notice into an email message to
the database administrator.", vbOKOnly, "Error Notice"
Resume Next
End Sub

Private Sub cmdAddNewProject_Click()
On Error GoTo ErrorTrap

Dim stDocName As String
Dim stLinkCriteria As String

DoCmd.Close

stDocName = "frm_New_Project"
DoCmd.OpenForm stDocName, , , stLinkCriteria, acFormAdd

Exit Sub

ErrorTrap:
MsgBox "The following error has occurred: " & vbCr & vbCr & _
Err.Number & " - " & Err.Description & vbCr & vbCr & _
"Press 'Alt + Print Scrn' to copy this notice into an email message to
the database administrator.", vbOKOnly, "Error Notice"
Resume Next
End Sub

Private Sub cmdSetFileLocation_Click()
'Build the File Location path from Agency and City

'check to make sure required fields are populated
If Len(Nz(Forms!frmProjects!txtProjectName)) = 0 Then
MsgBox "Enter a Project Name", vbOKOnly, "Project Name Missing"
Exit Sub
End If
If Len(Nz(Forms!frmProjects!cboAgency)) = 0 Then
MsgBox "Enter the Agency", vbOKOnly, "Agency Missing"
Exit Sub
End If
If Len(Nz(Forms!frmProjects!City)) = 0 Then
MsgBox "Enter the City", vbOKOnly, "City Missing"
Exit Sub
End If

Forms!frmProjects!FileLocation = Forms!frmProjects!txtProjectName &
"#M:\Leasing-And-Design\Jobs\" & Forms!frmProjects!cboAgency & "\" &
Forms!frmProjects!City & "#"
End Sub

Private Sub form_afterupdate()
fRequeryAll
End Sub

'Private Sub Form_BeforeUpdate(Cancel As Integer)
' Me!txtLastUpdate = Date
' Me!txtUpdatedBy = fOSUserName
'End Sub

Sub Form_Current()
If IsLoaded("frm_new_project") Then Exit Sub
Me!cboSelectProject = Me!ProjectID
Me!txtFocusTrap.SetFocus
authorization_check
If Len(Nz(Me!County)) = 0 Then Me!Label63.Visible = False Else
Me!Label63.Visible = True
If Len(Nz(Me!cboAgencyContact)) = 0 Then Me!Label93.Visible = False Else
Me!Label93.Visible = True
If Len(Nz(Me!DateInactive)) = 0 Then Me!Label97.Visible = False Else
Me!Label97.Visible = True
End Sub

Private Sub Form_Load()

'no need to perform any of the following procedures
' if the form was opened from frm_new_project.
If IsLoaded("frm_new_project") Then Exit Sub

'Go to the same record that was current
' the last time the form was open.
Dim varID As Variant
'MsgBox "form_load"
'Return to last project
varID = DLookup("Value", "tblSys", "[Variable] = 'frmProjectsLast'")
If IsNumeric(varID) Then
With Me.RecordsetClone
.FindFirst "[ProjectID] = " & varID
If Not .NoMatch Then
Me.Bookmark = .Bookmark
End If
End With
End If

authorization_check

End Sub

Private Sub Form_Unload(Cancel As Integer)
'Call the function "Set_frmProjectsLast"
' to store the ID of the current record, so the form will open
' to that same record the next time it opens.

Set_frmProjectsLast

End Sub

Private Sub cmd_close_form_Click()
On Error GoTo Err_cmd_close_form_Click

DoCmd.Close

Exit_cmd_close_form_Click:
Exit Sub

Err_cmd_close_form_Click:
MsgBox Err.Description
Resume Exit_cmd_close_form_Click

End Sub

Private Sub Notes_DblClick(Cancel As Integer)
On Error GoTo Err_Notes_DblClick

Dim stDocName As String
Dim stLinkCriteria As String

stDocName = "frmProjectNotes"
stLinkCriteria = "[ProjectID]=" & Me![ProjectID]

If authorization_check = True Then
DoCmd.RunCommand acCmdSaveRecord
DoCmd.OpenForm stDocName, , , stLinkCriteria
Else
Me.Undo
DoCmd.OpenForm stDocName, , , stLinkCriteria, acFormReadOnly
End If

Exit_Notes_DblClick:
Exit Sub

Err_Notes_DblClick:
MsgBox Err.Description
Resume Exit_Notes_DblClick
End Sub

Private Sub Status_AfterUpdate()
If Me!Status <> "Active" Then
Me!DateInactive = Date
Else
Me!DateInactive = ""
End If
End Sub

Private Sub Zip_AfterUpdate()
If Not IsNull(Me!Zip) Then
Me!City = DLookup("City", "tblCityZip", "Zip = " & Zip)
Me!State = DLookup("State", "tblCityZip", "Zip = " & Zip)
Me!County = DLookup("County", "tblCityZip", "City = '" & City & "'")
End If

If Len(Nz(Me!cboAgency)) > 0 And Len(Nz(Me!City)) > 0 And
Len(Nz(Me!txtProjectID)) > 0 Then
Me!txtProjectName = Me!cboAgency & "_" & Me!City & "_" &
Me!txtProjectID
End If
Me!cboSelectProject.Requery
Me.Repaint
fRequeryAll
End Sub

 

[Ken Snell \(MVP\)]

I don't see anything in the main form's code that would cause that previous
behavior.

However, may I suggest that you change the code for your function
authorization_check? The way it's set up in your code right now, it's
essentially a recursive function that calls itself over and over. May I
suggest that you change it to this:

Private Sub authorization_check()
Dim blnauthorization_check As Boolean
'Determine if the user is a member of the project and set the authorization
for form and both subforms.

'If we're just adding a new record to the form, don't run this function
If Me.RecordsetClone.RecordCount < 2 Then Exit Sub

'begin authorization check
Dim db As Database
Dim rs As Recordset
Dim strSql As String
Set db = CurrentDb
strSql = "SELECT tblProject.ProjectID, tblContacts.osUserName FROM
tblProject INNER JOIN (tblContacts INNER JOIN tblProjectContact ON
tblContacts.ContactID = tblProjectContact.ContactID) ON tblProject.ProjectID
= tblProjectContact.ProjectID WHERE (tblProject.ProjectID = " &
Forms!frmProjects!txtProjectID & ") AND tblContacts.osUserName =
fosUserName();"
Set rs = db.OpenRecordset(strSql, dbOpenDynaset)
If rs.RecordCount > 0 Then
blnauthorization_check = True
Else
blnauthorization_check = False
End If

Me.AllowEdits = blnauthorization_check
Me.AllowDeletions = blnauthorization_check
Me!frmProjectContactsSub.Form.AllowEdits = blnauthorization_check
Me!frmProjectContactsSub.Form.AllowAdditions = blnauthorization_check
Me!frmProjectContactsSub.Form.AllowDeletions = blnauthorization_check
Me!ctlLeases.Form.AllowEdits = blnauthorization_check
Me!ctlLeases.Form.AllowAdditions = blnauthorization_check
Me!ctlLeases.Form.AllowDeletions = blnauthorization_check

'end authorization check
End Sub

 

[Paul]

Just to make sure I understand the reason for the change - is using a
Boolean variable in a Sub procedure instead of a function value a way to
avoid recursion problems? I can tell you that using it as a funtion does
work, and produces the desired result, however, I'm always interested in
improving my code, so I'll follow your suggestion, Ken.

Paul

 

[Ken Snell \(MVP\)]

The reason I suggest the change is to avoid possible recursion problem
because you are calling the function within the function. In your original
code, you had lines like this:

Me!frmProjectContactsSub.Form.AllowEdits = authorization_check

This tells ACCESS to call the same function in which you're running this
code step, and thus the function runs before it's done, and gets to this
line again, and repeats the process. The fact that you're not seeing a
problem may indicate that ACCESS is not running the function recursively
(possibly because you don't provide any arguments to the function, so ACCESS
may think it is a "constant" function).

But, what I've recommended is an alternative way to write your code by
avoiding this situation entirely.

 

[Paul]

Thanks for explaining why this is a better way to write the function, Ken.
This will probably help me avoid creating recursion problems for myself down
the road.

Paul