troubleshooting Question

Form updates unbound fields on form close

Avatar of Cecelia Rieb
Cecelia RiebFlag for United States of America asked on
DatabasesMicrosoft Access
2 Comments1 Solution102 ViewsLast Modified:
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


Join our community to see this answer!
Unlock 1 Answer and 2 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 1 Answer and 2 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros