Avatar of Cecelia Rieb
Cecelia RiebFlag for United States of America

asked on 

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]

DatabasesMicrosoft Access

Avatar of undefined
Last Comment
Cecelia Rieb
ASKER CERTIFIED SOLUTION
Avatar of Scott McDaniel (EE MVE )
Scott McDaniel (EE MVE )
Flag of United States of America image

Blurred text
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
Avatar of Cecelia Rieb
Cecelia Rieb
Flag of United States of America image

ASKER

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

Microsoft Access is a rapid application development (RAD) relational database tool. Access can be used for both desktop and web-based applications, and uses VBA (Visual Basic for Applications) as its coding language.

226K
Questions
--
Followers
--
Top Experts
Get a personalized solution from industry experts
Ask the experts
Read over 600 more reviews

TRUSTED BY

IBM logoIntel logoMicrosoft logoUbisoft logoSAP logo
Qualcomm logoCitrix Systems logoWorkday logoErnst & Young logo
High performer badgeUsers love us badge
LinkedIn logoFacebook logoX logoInstagram logoTikTok logoYouTube logo