Form updates unbound fields on form close

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.Requery
    Me.lstPrograms = Null
    Me.lstProgramsCons.Requery
   
    If lstProgramsCons.MultiSelect = 0 Then
        lstProgramsCons = Null
    Else
        For Each varItem2 In lstProgramsCons.ItemsSelected
            lstProgramsCons.Selected(varItem2) = False
        Next
    End If
   
    Me.cmbDepartment.SetFocus
     
'     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
            Me.txtRecommendation.SetFocus
            Exit Sub
        End If
    Else
        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_cmdSave_Click:
    Exit Sub

Err_cmdSave_Click:
    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
        Else
            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

code]

Cecelia RiebDatabase AdministratorAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
You're setting the value of several items in different places, for example:

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

This would set the value of DeptNum, and whatever field is bound to txtDept, to the value in cmbDepartment. Any portion of your code that does this would update values.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Cecelia RiebDatabase AdministratorAuthor Commented:
OK, wow, I have been looking at this too long.  I totally missed that, thank you!  That did it.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Databases

From novice to tech pro — start learning today.