We help IT Professionals succeed at work.

Form updates unbound fields on form close

Last Modified: 2018-08-22
I'm running Access 2013 and using a form to update records in the bound table.  What should happen is the user selects a department from an unbound combo box, then selects a program from an unbound list box, the values for which are generated by query inside the form.  The AfterUpdate code associated with this list box then filters the bound table so that any changes the user makes to the bound fields in the form only impact the selected/filtered record.  However, if I select a department, click on an item in the list box, then click a different item (single select), then close the form without clicking my Save command button, the form has changed the value in the bound table for department number and program number.  I can't find what in the code or the form would make it update the values for those two fields.  The complete form code is below.  I'm also attaching a dummied-up version of the database for reference to the form structure (the underlying code has changed but the form itself has not).  Could someone please point me to the error in my ways?

This is a continuation of this thread () but the issue is different.

Form Code:
[code][/Option Compare Database
Option Explicit
Private blnGood As Boolean
Public strDeptID As String 'Long 'String 'Variant
Public strProgramNbr As Integer

Private Sub cmbDepartment_AfterUpdate()

'Dim strDeptID As String
Dim varItem2 As Variant

        strDeptID = Me.cmbDepartment.Value
        Me.[DeptNum] = strDeptID
        Me.txtDept = strDeptID

    Me.lstPrograms = Null
    If lstProgramsCons.MultiSelect = 0 Then
        lstProgramsCons = Null
        For Each varItem2 In lstProgramsCons.ItemsSelected
            lstProgramsCons.Selected(varItem2) = False
    End If
'     If Me.Dirty Then
'      lstPrograms_AfterUpdate
'     End If

End Sub

Private Sub cmdSave_Click()

 Dim stDocName As String
' MsgBox Me.txtRecommendation

If Me.Dirty Then

    If IsNull(Me.txtRecommendation) Then
        If MsgBox("You did not enter any recommendatons.  Save anyway?", vbDefaultButton2 + vbQuestion + vbYesNo, "EMPTY") = vbNo Then
            Exit Sub
        End If
        blnGood = True

        Dim varItem As Variant
        Dim strSQL As String
        Dim strPgmNbr2 As Integer
        Dim lngIndexSelected2 As Long
        If lstProgramsCons.ItemsSelected.Count <> 0 Then 'GoTo Exit_cmdSave_Click

            For Each varItem In Me.lstProgramsCons.ItemsSelected
                With Me.lstProgramsCons
'                    lngIndexSelected2 = .ListIndex + IIf(.ColumnHeads, 1, 0)
                    strPgmNbr2 = .Column(1, varItem)
                End With

                strSQL = "UPDATE tblProgramConsolidation SET [Recommendation] = """ & Me.txtRecommendation & """,[Name of Consolidated Program] = """ & Me.txtNewPgmName & _
                    """WHERE [DeptNum] = """ & strDeptID & """ & [ProgramNum] = " & strPgmNbr2 & ""
                CurrentDb.Execute strSQL, dbFailOnError
                Debug.Print strSQL
            Next varItem
        End If
'    If Me.NewRecord And strProgramNbr <> "0" Then
'       Me!ProgramNum = strProgramNbr
'       Me!DeptNum = strDeptID
'    End If

        DoCmd.RunCommand acCmdSaveRecord
'        Me.FilterOn = True
        blnGood = False
    End If
End If

    Exit Sub

    MsgBox Err.Description
    Resume Exit_cmdSave_Click

End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
'    Dim strMsg As String
'    If Not blnGood Then
'        Cancel = True
'        strMsg = "Please use the Save button to save your changes," & _
'                 vbNewLine & "or Escape to reset them."
'        Call MsgBox(Prompt:=strMsg, Title:="Before Update")
'    End If
End Sub

Private Sub lstPrograms_AfterUpdate()
    Dim strFilter As String
    Dim lngIndexSelected As Long
    strProgramNbr = 0
    strDeptID = 0
    If Not IsNull(Me.cmbDepartment.Value) Then
        strDeptID = Me.[DeptNum]
    End If
    With Me.lstPrograms
         If .ListIndex > -1 Then
            lngIndexSelected = .ListIndex + IIf(.ColumnHeads, 1, 0)
            strProgramNbr = .Column(2, lngIndexSelected)
        End If
    End With
    strFilter = "[DeptNum]=""" & strDeptID & """ and [ProgramNum]=" & strProgramNbr

    Me.Filter = strFilter
    Me.FilterOn = True
    'populate text boxes with Recommendation from table
    Dim varRec
    Dim varCons

     varRec = DLookup("[Recommendation]", "tblProgramConsolidation", "DeptNum=""" & Me.strDeptID & """ and ProgramNum=" & Me.strProgramNbr)
        If Not IsNull(varRec) Then
            Me.txtRecommendation = varRec
            Me.txtRecommendation = ""
        End If
''     varCons = DLookup("[Consolidated Program Numbers]", "tblProgramConsolidation", "DeptNum=""" & strDeptID & """ and ProgramNum=" & strProgramNbr)
''        If Not IsNull(varRec) Then
''            Me.txtRecommendation = varCons
''        Else
''            Me.txtRecommendation = ""
''        End If
'    If Me.NewRecord And strProgramNbr <> "0" Then
'       Me!ProgramNum = strProgramNbr
'       Me!DeptNum = strDeptID
'    End If

    Me.txtMultSelect = Null
    Me.lstProgramsCons.Enabled = False
    Me.txtNewPgmName.Enabled = False
End Sub

Private Sub lstProgramsCons_AfterUpdate()
'    If Me.lstProgramsCons.ListCount = 0 And Me.txtRecommendation = "Consolidate" Then
'        If MsgBox("You did not select any programs to consolidate.  Save anyway?", vbDefaultButton2 + vbQuestion + vbYesNo, "EMPTY") = vbNo Then
'            Me.lstProgramsCons.SetFocus
'            Exit Sub
'        End If
'    Else
'        Dim varItem As Variant
'        Dim strSQL As String
'        For Each varItem In Me.lstProgramsCons.ItemsSelected
'            strSQL = "UPDATE tblProgramConsolidation SET [Recommendation] = """ _
'                      & txtRecommendation & """WHERE DeptNum = " & strDeptID & " & ProgramNum = " & Me.ProgramNum & ""
'           CurrentDb.Execute strSQL, dbFailOnError
'        Next
'    End If
End Sub

Private Sub txtRecommendation_AfterUpdate()

If [Recommendation] = "Consolidate" Then
    Me.lstProgramsCons.Enabled = True
    Me.txtNewPgmName.Enabled = True
'    Me.lstProgramsCons = Null
'    Me.txtMultSelect = Null
End If

If [Recommendation] <> "Consolidate" Then
    Me.lstProgramsCons.Enabled = False
    Me.txtNewPgmName.Enabled = False
'    Me.lstProgramsCons = Null
'    Me.txtMultSelect = Null
End If

If [Recommendation] = "Break Out" Then
    Me.txtBreakOut.Enabled = True
End If

If [Recommendation] <> "Break Out" Then
    Me.txtBreakOut.Enabled = False
End If

End Sub


Watch Question

Infotrakker Software
Most Valuable Expert 2012
Top Expert 2014
This one is on us!
(Get your first solution completely free - no credit card required)
Cecelia RiebDatabase Administrator


OK, wow, I have been looking at this too long.  I totally missed that, thank you!  That did it.

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.


Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.