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.MultiSelec
t = 0 Then
lstProgramsCons = Null
Else
For Each varItem2 In lstProgramsCons.ItemsSelec
ted
lstProgramsCons.Selected(v
arItem2) = 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.txtRecommendatio
n) Then
If MsgBox("You did not enter any recommendatons. Save anyway?", vbDefaultButton2 + vbQuestion + vbYesNo, "EMPTY") = vbNo Then
Me.txtRecommendation.SetFo
cus
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.ItemsSelec
ted.Count <> 0 Then 'GoTo Exit_cmdSave_Click
For Each varItem In Me.lstProgramsCons.ItemsSe
lected
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.Va
lue) 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_AfterUpdat
e()
' If Me.lstProgramsCons.ListCou
nt = 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.SetFocu
s
' Exit Sub
' End If
'
' Else
' Dim varItem As Variant
' Dim strSQL As String
'
' For Each varItem In Me.lstProgramsCons.ItemsSe
lected
' strSQL = "UPDATE tblProgramConsolidation SET [Recommendation] = """ _
' & txtRecommendation & """WHERE DeptNum = " & strDeptID & " & ProgramNum = " & Me.ProgramNum & ""
' CurrentDb.Execute strSQL, dbFailOnError
' Next
' End If
End Sub
Private Sub txtRecommendation_AfterUpd
ate()
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]
ASKER