Link to home
Start Free TrialLog in
Avatar of jondecker76
jondecker76

asked on

OnCurrent() event steals control focus!

I have a fairly complex form, with a form query, and a listbox with its own query. The only way I have been able to "synchronise" these two is by requerying the list in the OnCurrent event of the form.

It seems to work well, however, I will enter data in a field, then I will put my cursor in another field to enter more data. When I switch fields, the OnCurrent event fires , the requery happens (As it should), but when it is finished, the cursor is not in the control anymore, so I have to click the field I want to change again so that I can enter data.

The end result is that I have to click on each field (textbox in my case) two times each to enter data.

Is there a way to prevent my controls from losing focus when the Form's OnCUrrent() event fires?
Avatar of Scott McDaniel (EE MVE )
Scott McDaniel (EE MVE )
Flag of United States of America image

Requery "rebuilds" the current dataset, and would place your cursor in the first control in the Tab order (normally).  However, requerying the Listbox should NOT fire the form's Current event, unless you're using something like SetFocus, Activate etc. Can you post the code you're using?
Though I agree with LMS, try this...
' Declaration
Dim strControl as String
 
' Put at beginning of OnCurrent
strControl = ActiveControl.Name
 
' Put at end of OnCurrent
Controls(strControl).SetFocus

Open in new window

Avatar of jondecker76
jondecker76

ASKER

I'm sorry if I didn't explain it right. Its actually the OnCurrent event of the form thats requiring the list box - not the other way around.

------------
TABLES
------------
HMI_Matrix 'This table stores On-Screen display items for a display system
     PK_HMI_Matrix
     FK_Partition
     FK_Module
     locationX
     locationY
     color
     name

Partition ' This table "partitions" a complex UI into separate logical areas
    PK_Partition
    name
    screen
   

Module 'This table hold information to a hardware module. Each HMI_Matrix entry references a Module
     PK_Module
     address
     tagname
     description

-------------
Main Form:
-------------
The main form does a "Select * FROM HMI_Matrix" query. It has several text fields on the bottom of the form, each one relating to a field in the database.
There is a listbox on top of the form (lstHMI). It has no control source - it uses its own SELECT query to query a link table for a many-to-many relationship. This is why I need it to be in sync with the rest of the form.
frmMain:
Private Sub Form_Current()
    'Requery the listbox
    Me.lstHMI.Requery
    'Filter the rest of the fields by the selected listbox item
    Me.Filter = "[PK_HMI_Matrix]=" & Me.lstHMI
    Me.FilterOn = True
End Sub

My main form's query looks up a HMI_Matrix entry, and displays fields for editing. At the top of this form, the listbox lstHMI queries all HMI_Matrix entries against a certain Module. When one of the HMI_Matrix entries in the listbox is clicked, it updates the form filter so that only the selected item's data is presented.

The only relavent code is shown above. When an item is selected in the listbox, the Form's onCUrrent event fires, and syncronizes the rest of the form to the listbox. Likewise, after editing an HMI_Matrix entry, the ONCurrent event fires, and the listbox is updated to reflect the changes.

The problem is, my cursor loses focus each and every time

I wish I could post my database here, but it is over 30MB in size :(


How does this happen? Can you show the code behind the Listbox events?



How does this happen? Are you running code in the controls to do this?

Filtering will force your cursor to the first control in the Tab order as well. You can't stop this - this is built in and expected behavior.
LSMConsulting:
I tried your suggestion, but I get errors:
"Runtime Error '2474'
The expression you entered requires the control to be in the active window"

The form the lstHMI is on is a subform of a subform of a main form, and nested within two tab groups - so it will not always be in the active window.

I just took a screenshot and added some text to explain it better.
project.jpg
I haven't made any suggestions ... just asked that you post the code that seems to be giving you trouble.
sorry, my bad

Private Sub Form_Current()
    'Requery the listbox
    Me.lstHMI.Requery
    'Filter the rest of the fields by the selected listbox item
    Me.Filter = "[PK_HMI_Matrix]=" & Me.lstHMI
    Me.FilterOn = True
End Sub


this is the only related code
Do you have any code running behind the Listbox, or in any Control? The current event you listed will force a requery, but it's happening at the same time as the Current event so I don't see where this would cause you trouble.

Any code in the Change/After-Before UPdate/Enter/Exit events of your bound controls?
No, no other code attached to any other events, an no code in the listbox directly
I did not know we were dealing with controls on subforms... please supply the code for the subform that the list box is on... the code will not be found on the main form.
that was the code from the subform containing the listbox - it is in the subform's onCurrent event

this is the only code throughout the entire project that deals with that subform or the listbox
Okay ... if ya don't wanna give us the code, we can't help ya. Good luck with your project, I'm outta here.
I JUST POSTED THE CODE 3 TIMES, here let me do it again
Private Sub Form_Current()
    'Requery the listbox
    Me.lstHMI.Requery
    'Filter the rest of the fields by the selected listbox item
    Me.Filter = "[PK_HMI_Matrix]=" & Me.lstHMI
    Me.FilterOn = True
End Sub


and again
Private Sub Form_Current()
    'Requery the listbox
    Me.lstHMI.Requery
    'Filter the rest of the fields by the selected listbox item
    Me.Filter = "[PK_HMI_Matrix]=" & Me.lstHMI
    Me.FilterOn = True
End Sub

and again
Private Sub Form_Current()
    'Requery the listbox
    Me.lstHMI.Requery
    'Filter the rest of the fields by the selected listbox item
    Me.Filter = "[PK_HMI_Matrix]=" & Me.lstHMI
    Me.FilterOn = True
End Sub
*sigh*  I think LSM is getting a little flustered...

jon, I don't think you are trying to not post what we are looking for so let me help clarify.

When a subform is linked to a form there is then all sorts of things that a developer must look at.  I have known of one part of my applications erring and it being related to something that's happening elsewhere (to a seemingly unrelated item).

The only suggestion I have for you is to supply all code to each form (subforms included) affiliated with this issue.  This could be related to an OnCurrent event on a different subform in the form that you sent a screenshot of as far as we know...

The only way to find out, is to supply us with at least more code.
jondecker76

Or,...

Simply attach a sanitized sample of your db here.
;-)

JeffCoachman
Attached is the code from all 3 forms involved.

I am sorry, I was unaware you wanted this much code posted (as again, the only code referencing lstHMI was already posted)
------------------
frmEditPartitions: (this is the main form)
------------------
Private Sub PopulateBrowser()
    ' Find the record that matches.
    Dim rs As Object
    Me.cmbBrowse.Requery
    Set rs = Me.Recordset.Clone
    rs.FindFirst "[PK_Partition] = " & Str(Nz(Me![cmbBrowse], 0))
    If Not rs.EOF Then Me.Bookmark = rs.Bookmark
End Sub
 
 
 
Private Sub cmbBrowse_Change()
    PopulateBrowser
End Sub
 
Private Sub FK_System_Change()
    'PopulateBrowser
End Sub
 
Private Sub Form_Load()
    Dim rs As Object
    'Lets preselect the first combobox entry so it doesn't start blank
    Me.cmbBrowse = Me.cmbBrowse.Column(0, 0) '(0,N) - index is n+1
    'and load associated data
    Set rs = Me.Recordset.Clone
    rs.FindFirst "[PK_Partition] = " & Str(Nz(Me![cmbBrowse], 0))
    If Not rs.EOF Then Me.Bookmark = rs.Bookmark
    
End Sub
 
Private Sub pgPoints_Click()
    'Module1.SelectIOControls
End Sub
 
Private Sub tabExtPartitionProperties_Change()
'If tabExtPartitionProperties.Value = 2 Then
'    frmPointData.Visible = True
'Else
'    frmPointData.Visible = False
'End If
'Me![frmPointData].Form![cmbPointIOType].SetFocus
End Sub
 
 
Private Sub cmdPreviewFS_Click()
On Error GoTo Err_cmdPreviewFS_Click
 
    Dim stDocName As String
 
    stDocName = "rptFunctional Spec"
    DoCmd.OpenReport stDocName, acPreview, , "PK_Partition=" & Me.cmbBrowse.value
 
 
Exit_cmdPreviewFS_Click:
    Exit Sub
 
Err_cmdPreviewFS_Click:
    MsgBox Err.description
    Resume Exit_cmdPreviewFS_Click
    
End Sub
Private Sub Command79_Click()
On Error GoTo Err_Command79_Click
 
    Dim stDocName As String
 
    stDocName = "rptFunctional Spec"
    DoCmd.OpenReport stDocName, acPreview
 
Exit_Command79_Click:
    Exit Sub
 
Err_Command79_Click:
    MsgBox Err.description
    Resume Exit_Command79_Click
    
End Sub
 
Private Sub cmdNewReference_Click()
On Error GoTo Err_cmdNewReference_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "frm_Pop_Point_Eng_Unit"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
 
Exit_cmdNewReference_Click:
    Exit Sub
 
Err_cmdNewReference_Click:
    MsgBox Err.description
    Resume Exit_cmdNewReference_Click
    
End Sub
Private Sub Command85_Click()
On Error GoTo Err_Command85_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "frm_Pop_AddReference"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
 
Exit_Command85_Click:
    Exit Sub
 
Err_Command85_Click:
    MsgBox Err.description
    Resume Exit_Command85_Click
    
End Sub
Private Sub Command86_Click()
On Error GoTo Err_Command86_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "frm_Pop_AddPoint"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
 
Exit_Command86_Click:
    Exit Sub
 
Err_Command86_Click:
    MsgBox Err.description
    Resume Exit_Command86_Click
    
End Sub
Private Sub cmdOpenAddModule_Click()
On Error GoTo Err_cmdOpenAddModule_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "frm_pop_AddModule"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
 
Exit_cmdOpenAddModule_Click:
    Exit Sub
 
Err_cmdOpenAddModule_Click:
    MsgBox Err.description
    Resume Exit_cmdOpenAddModule_Click
    
End Sub
Private Sub cmdSearchAndMove_Click()
On Error GoTo Err_cmdSearchAndMove_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "frm_Pop_SearchPoint"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
 
Exit_cmdSearchAndMove_Click:
    Exit Sub
 
Err_cmdSearchAndMove_Click:
    MsgBox Err.description
    Resume Exit_cmdSearchAndMove_Click
    
End Sub
Private Sub Command96_Click()
On Error GoTo Err_Command96_Click
 
 
    DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
 
Exit_Command96_Click:
    Exit Sub
 
Err_Command96_Click:
    MsgBox Err.description
    Resume Exit_Command96_Click
    
End Sub
Private Sub cmdRefresh_Click()
On Error GoTo Err_cmdRefresh_Click
 
 
    DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70
 
Exit_cmdRefresh_Click:
    Exit Sub
 
Err_cmdRefresh_Click:
    MsgBox Err.description
    Resume Exit_cmdRefresh_Click
    
End Sub
 
--------------
;frmModuleData
--------------
Option Compare Database
 
 
 
 
Private Sub cdmDeleteTrip_Click()
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim msgResult As VbMsgBoxResult
    
    
    If Me.lstTrips.value Then
        msgResult = MsgBox("Are you sure you want to delete this trip?", vbYesNo, "Delete Trips")
        
        If msgResult = vbYes Then
           'Get connection to database
            Set dbs = CurrentDb()
            'Build SQL query
            strSQL = "DELETE FROM Trip_Matrix WHERE PK_Trip_Matrix = " & Me.lstTrips.value
            
            dbs.Execute strSQL
            Me.lstTrips.Requery
        Else
            Exit Sub
        End If
    Else
        MsgBox "No trip was selected. Please " & vbCrLf & "select a trip and try again.", vbOKOnly, "Delete Trips"
    End If
End Sub
 
 
Private Sub cmdAddAlarm_Click()
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
    
    'Get connection to database
    Set dbs = CurrentDb()
    'Build SQL query
    strSQL = strSQL & "INSERT INTO Alarm_Matrix "
    strSQL = strSQL & " (FK_Point,Name) VALUES (" & "'" & PK_Point & "','New Alarm')"
    
    'Execute SQL query
    dbs.Execute strSQL
    
    Me.lstAlarms.Requery
End Sub
 
Private Sub cmdAddInput_Click()
    'Lets add the input to the list
    Dim db As DAO.Database
    Dim qd As DAO.QueryDef
    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim varResult As Variant
    
    'Set the current database
    Set db = CurrentDb
 
    'Build SQL string
    strSQL = "INSERT INTO Module_Input_List (FK_Point,FK_Module) values "
    strSQL = strSQL & "(" & Me.cmbAddInput.value & ", " & [PK_Module] & ");"
    
    'MsgBox strSQL
    
    db.Execute (strSQL)
    'Requery the list
    Me.lstInput.Requery
    'select none in the point select
    Me.cmbAddInput = Null
End Sub
 
Private Sub cmdAddOutput_Click()
    'Lets add the output to the list
    Dim db As DAO.Database
    Dim qd As DAO.QueryDef
    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim varResult As Variant
    
    'Set the current database
    Set db = CurrentDb
 
    'Build SQL string
    strSQL = "INSERT INTO Module_Output_List (FK_Point,FK_Module) values "
    strSQL = strSQL & "(" & Me.cmbAddOutput.value & ", " & [PK_Module] & ");"
    
    'MsgBox strSQL
    
    db.Execute (strSQL)
    'Requery the list
    Me.lstOutput.Requery
    'select none in the point select
    Me.cmbAddOutput = Null
End Sub
 
 
Private Sub cmdAddTag_Click()
    On Error GoTo Err_cmdAddTag_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "frm_Pop_TripAffected"
    If IsNull(Me.lstTrips) Then
        MsgBox ("There is no trip selected. Please select a trip on the left, then try adding a tag again.")
    Else
        DoCmd.OpenForm stDocName, , , stLinkCriteria, , , CStr(Me.lstTrips.value)
    End If
    Me.lstAffected.Requery
Exit_cmdAddTag_Click:
    Exit Sub
 
Err_cmdAddTag_Click:
    MsgBox Err.description
    Resume Exit_cmdAddTag_Click
    
End Sub
 
Private Sub cmdAddTrip_Click()
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
    
    'Get connection to database
    Set dbs = CurrentDb()
    'Build SQL query
    strSQL = strSQL & "INSERT INTO Trip_Matrix "
    strSQL = strSQL & " (FK_Module,Name) VALUES (" & "'" & PK_Module & "','New Trip')"
    
    'Execute SQL query
    dbs.Execute strSQL
    
    Me.lstTrips.Requery
End Sub
 
 
Private Sub cmdDeleteAlarm_Click()
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim msgResult As VbMsgBoxResult
    
    
    If Me.lstAlarms.value Then
        msgResult = MsgBox("Are you sure you want to delete this alarm?", vbYesNo, "Delete Alarms")
        
        If msgResult = vbYes Then
           'Get connection to database
            Set dbs = CurrentDb()
            'Build SQL query
            strSQL = "DELETE FROM Alarm_Matrix WHERE PK_Alarm_Matrix = " & Me.lstAlarms.value
            
            dbs.Execute strSQL
            Me.lstAlarms.Requery
        Else
            Exit Sub
        End If
    Else
        MsgBox "No alarm was selected. Please " & vbCrLf & "select an alarm and try again.", vbOKOnly, "Delete Alarms"
    End If
End Sub
 
Private Sub cmdDeleteInput_Click()
    Dim db As DAO.Database
    Dim qd As DAO.QueryDef
    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim varResult As Variant
    
    'Set the current database
    Set db = CurrentDb
 
 
    If (Me.lstInput.value) Then
        'Build SQL string
        strSQL = "DELETE FROM Module_Input_List WHERE FK_Point=" & Me.lstInput.value & " AND FK_Module=" & [PK_Module] & ";"
        db.Execute (strSQL)
        Me.lstInput.Requery
    Else
        MsgBox "No input point was selected. Please select an input point and try again."
    End If
End Sub
 
 
 
 
 
Private Sub cmdDeleteOutput_Click()
    Dim db As DAO.Database
    Dim qd As DAO.QueryDef
    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim varResult As Variant
    
    'Set the current database
    Set db = CurrentDb
 
 
    If (Me.lstOutput.value) Then
        'Build SQL string
        strSQL = "DELETE FROM Module_Output_List WHERE FK_Point=" & Me.lstOutput.value & " AND FK_Module=" & [PK_Module] & ";"
        db.Execute (strSQL)
        Me.lstOutput.Requery
    Else
        MsgBox "No ouput point was selected. Please select an output point and try again."
    End If
End Sub
 
Private Sub cmdDeleteTag_Click()
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim msgResult As VbMsgBoxResult
    
    Set dbs = CurrentDb()
    
    If IsNull(Me.lstAffected) Then
        MsgBox ("There was no tag selected. Please select a tag, and try again.")
    Else
        strSQL = "DELETE FROM Trip_Matrix_Affected where PK_Trip_Matrix_Affected = " & Me.lstAffected.value & ";"
        dbs.Execute (strSQL)
        Me.lstAffected.Requery
    End If
End Sub
 
 
 
Private Sub Form_Current()
    Me.lstInput.Requery
    Me.lstOutput.Requery
    
    'HMI stuff
    Me!frmModuleData_HMI.Form!lstHMI.Requery
    Me!frmModuleData_HMI.Form!lstHMI.Selected(0) = True
    If IsNull(Me!frmModuleData_HMI.Form!lstHMI) Then
        'Null!
        
    Else
        'Not null! Lets display
        Me!frmModuleData_HMI.Form.Filter = "[PK_HMI_Matrix]=4" '& Me.frmModuleData_HMI.Form.lstHMI
        'Forms!frmModuleData.frmModuleData_HMI.Form.Filter = "[PK_HMI_Matrix]=" & Forms!frmModuleData.frmModuleData_HMI.Form.lstHMI
 
        Me!frmModuleData_HMI.Form.FilterOn = True
        Me!frmModuleData_HMI.Form.Filter = "[PK_HMI_Matrix]=" & Me.frmModuleData_HMI.Form.lstHMI
        'Forms!frmModuleData.frmModuleData_HMI.Form.Filter = "[PK_HMI_Matrix]=" & Forms!frmModuleData.frmModuleData_HMI.Form.lstHMI
 
        Me!frmModuleData_HMI.Form.FilterOn = True
 
    End If
   
 
End Sub
 
 
Private Sub Command34_Click()
    Me.lstInput.Requery
    Me.lstOutput.Requery
End Sub
 
-------------------------------------------------------------
'frmModuleData (this is the subform that is in the main form frmEditPartitions)
-------------------------------------------------------------
Option Compare Database
 
 
 
 
Private Sub cdmDeleteTrip_Click()
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim msgResult As VbMsgBoxResult
    
    
    If Me.lstTrips.value Then
        msgResult = MsgBox("Are you sure you want to delete this trip?", vbYesNo, "Delete Trips")
        
        If msgResult = vbYes Then
           'Get connection to database
            Set dbs = CurrentDb()
            'Build SQL query
            strSQL = "DELETE FROM Trip_Matrix WHERE PK_Trip_Matrix = " & Me.lstTrips.value
            
            dbs.Execute strSQL
            Me.lstTrips.Requery
        Else
            Exit Sub
        End If
    Else
        MsgBox "No trip was selected. Please " & vbCrLf & "select a trip and try again.", vbOKOnly, "Delete Trips"
    End If
End Sub
 
 
Private Sub cmdAddAlarm_Click()
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
    
    'Get connection to database
    Set dbs = CurrentDb()
    'Build SQL query
    strSQL = strSQL & "INSERT INTO Alarm_Matrix "
    strSQL = strSQL & " (FK_Point,Name) VALUES (" & "'" & PK_Point & "','New Alarm')"
    
    'Execute SQL query
    dbs.Execute strSQL
    
    Me.lstAlarms.Requery
End Sub
 
Private Sub cmdAddInput_Click()
    'Lets add the input to the list
    Dim db As DAO.Database
    Dim qd As DAO.QueryDef
    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim varResult As Variant
    
    'Set the current database
    Set db = CurrentDb
 
    'Build SQL string
    strSQL = "INSERT INTO Module_Input_List (FK_Point,FK_Module) values "
    strSQL = strSQL & "(" & Me.cmbAddInput.value & ", " & [PK_Module] & ");"
    
    'MsgBox strSQL
    
    db.Execute (strSQL)
    'Requery the list
    Me.lstInput.Requery
    'select none in the point select
    Me.cmbAddInput = Null
End Sub
 
Private Sub cmdAddOutput_Click()
    'Lets add the output to the list
    Dim db As DAO.Database
    Dim qd As DAO.QueryDef
    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim varResult As Variant
    
    'Set the current database
    Set db = CurrentDb
 
    'Build SQL string
    strSQL = "INSERT INTO Module_Output_List (FK_Point,FK_Module) values "
    strSQL = strSQL & "(" & Me.cmbAddOutput.value & ", " & [PK_Module] & ");"
    
    'MsgBox strSQL
    
    db.Execute (strSQL)
    'Requery the list
    Me.lstOutput.Requery
    'select none in the point select
    Me.cmbAddOutput = Null
End Sub
 
 
Private Sub cmdAddTag_Click()
    On Error GoTo Err_cmdAddTag_Click
 
    Dim stDocName As String
    Dim stLinkCriteria As String
 
    stDocName = "frm_Pop_TripAffected"
    If IsNull(Me.lstTrips) Then
        MsgBox ("There is no trip selected. Please select a trip on the left, then try adding a tag again.")
    Else
        DoCmd.OpenForm stDocName, , , stLinkCriteria, , , CStr(Me.lstTrips.value)
    End If
    Me.lstAffected.Requery
Exit_cmdAddTag_Click:
    Exit Sub
 
Err_cmdAddTag_Click:
    MsgBox Err.description
    Resume Exit_cmdAddTag_Click
    
End Sub
 
Private Sub cmdAddTrip_Click()
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
    
    'Get connection to database
    Set dbs = CurrentDb()
    'Build SQL query
    strSQL = strSQL & "INSERT INTO Trip_Matrix "
    strSQL = strSQL & " (FK_Module,Name) VALUES (" & "'" & PK_Module & "','New Trip')"
    
    'Execute SQL query
    dbs.Execute strSQL
    
    Me.lstTrips.Requery
End Sub
 
 
Private Sub cmdDeleteAlarm_Click()
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim msgResult As VbMsgBoxResult
    
    
    If Me.lstAlarms.value Then
        msgResult = MsgBox("Are you sure you want to delete this alarm?", vbYesNo, "Delete Alarms")
        
        If msgResult = vbYes Then
           'Get connection to database
            Set dbs = CurrentDb()
            'Build SQL query
            strSQL = "DELETE FROM Alarm_Matrix WHERE PK_Alarm_Matrix = " & Me.lstAlarms.value
            
            dbs.Execute strSQL
            Me.lstAlarms.Requery
        Else
            Exit Sub
        End If
    Else
        MsgBox "No alarm was selected. Please " & vbCrLf & "select an alarm and try again.", vbOKOnly, "Delete Alarms"
    End If
End Sub
 
Private Sub cmdDeleteInput_Click()
    Dim db As DAO.Database
    Dim qd As DAO.QueryDef
    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim varResult As Variant
    
    'Set the current database
    Set db = CurrentDb
 
 
    If (Me.lstInput.value) Then
        'Build SQL string
        strSQL = "DELETE FROM Module_Input_List WHERE FK_Point=" & Me.lstInput.value & " AND FK_Module=" & [PK_Module] & ";"
        db.Execute (strSQL)
        Me.lstInput.Requery
    Else
        MsgBox "No input point was selected. Please select an input point and try again."
    End If
End Sub
 
 
 
 
 
Private Sub cmdDeleteOutput_Click()
    Dim db As DAO.Database
    Dim qd As DAO.QueryDef
    Dim rs As DAO.Recordset
    Dim strSQL As String
    Dim varResult As Variant
    
    'Set the current database
    Set db = CurrentDb
 
 
    If (Me.lstOutput.value) Then
        'Build SQL string
        strSQL = "DELETE FROM Module_Output_List WHERE FK_Point=" & Me.lstOutput.value & " AND FK_Module=" & [PK_Module] & ";"
        db.Execute (strSQL)
        Me.lstOutput.Requery
    Else
        MsgBox "No ouput point was selected. Please select an output point and try again."
    End If
End Sub
 
Private Sub cmdDeleteTag_Click()
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
    Dim msgResult As VbMsgBoxResult
    
    Set dbs = CurrentDb()
    
    If IsNull(Me.lstAffected) Then
        MsgBox ("There was no tag selected. Please select a tag, and try again.")
    Else
        strSQL = "DELETE FROM Trip_Matrix_Affected where PK_Trip_Matrix_Affected = " & Me.lstAffected.value & ";"
        dbs.Execute (strSQL)
        Me.lstAffected.Requery
    End If
End Sub
 
 
 
Private Sub Form_Current()
    Me.lstInput.Requery
    Me.lstOutput.Requery
    
    'HMI stuff
    Me!frmModuleData_HMI.Form!lstHMI.Requery
    Me!frmModuleData_HMI.Form!lstHMI.Selected(0) = True
    If IsNull(Me!frmModuleData_HMI.Form!lstHMI) Then
        'Null!
        
    Else
        'Not null! Lets display
        Me!frmModuleData_HMI.Form.Filter = "[PK_HMI_Matrix]=4" '& Me.frmModuleData_HMI.Form.lstHMI
        'Forms!frmModuleData.frmModuleData_HMI.Form.Filter = "[PK_HMI_Matrix]=" & Forms!frmModuleData.frmModuleData_HMI.Form.lstHMI
 
        Me!frmModuleData_HMI.Form.FilterOn = True
        Me!frmModuleData_HMI.Form.Filter = "[PK_HMI_Matrix]=" & Me.frmModuleData_HMI.Form.lstHMI
        'Forms!frmModuleData.frmModuleData_HMI.Form.Filter = "[PK_HMI_Matrix]=" & Forms!frmModuleData.frmModuleData_HMI.Form.lstHMI
 
        Me!frmModuleData_HMI.Form.FilterOn = True
 
    End If
   
 
End Sub
 
 
Private Sub Command34_Click()
    Me.lstInput.Requery
    Me.lstOutput.Requery
End Sub
 
-----------------
'frmModuleData_HMI (this is the subform nested in subform frmModuleData)
-----------------
Option Compare Database
Public Sub SelectType()
    'Lets make sure we don't have focus
    Me.cmbType.SetFocus
     If cmbType.value = 1 Then
        'this is a proprietary control - enable extra fields
        Me.txtPurpose.Locked = False
        Me.txtPurpose.Enabled = True
        Me.txtPurpose.BackColor = 16777215
        'Me.txtDefaults.Locked = False
        'Me.txtDefaults.Enabled = True
        'Me.txtDefaults.BackColor = 16777215
        'Me.txtResets.Locked = False
        'Me.txtResets.Enabled = True
        'Me.txtResets.BackColor = 16777215
    Else
        'this is not a proprietary control - disable extra fields
        Me.txtPurpose.Locked = True
        Me.txtPurpose.Enabled = False
        Me.txtPurpose.BackColor = 12632256
        'Me.txtDefaults.Locked = True
        'Me.txtDefaults.Enabled = False
        'Me.txtDefaults.BackColor = 12632256
        'Me.txtResets.Locked = True
        'Me.txtResets.Enabled = False
        'Me.txtResets.BackColor = 12632256
    End If
End Sub
 
 
 
Private Sub cmbType_Change()
   Me.SelectType
End Sub

Open in new window

oops - i pasted frmModuleData twice....
Yeah... attach a sanitized sample of your db... i have no clue... I want to see it in action and step through the code....

Tony
Ok I finally have a sanitized sample ready. I've deleted all of the entries (there are tens of thousands of entries across many tables) and added just enough sample data to see how it works.

As you can see, this project has turned out to be grosely complex. I am also not big on VBA or Access (I have a background in mysql and PHP). I feel that project has almost become unmanagable because of the constraints of VBA (or my lack of understanding of VBA and its structure)

Can you please look at it, and tell me if I should be tackling this differently?

For example, I have tried a couple different approaches...  If you look under the "Points" tab you will see a "Human Machine Interface" tab. If you look under the "Modules" tab, you will see an "HMI" tab.. These are they same thing, only one attaches an HMI control to a Point, and the other attaches an HMI control to a module. But also notice that one is done on a single subform, and the other on multiple subforms. (Ideally I could have used the same HMI subfrom for both points and modules, but this is where I feel VBA is extremely ugly)

Any tips, critisism and/or Advice would be a great help. I have about a month and a half left on this project and I want it to be usable, and bug free (right now its riddled with bugs, even down to requerying some things several times in a pop)

The project is to help manage the upgrade to a different process control system at a major chemical plant. I got handed this because I have relational database experience.. Unfortunately, my experience isn't in microsoft products.....
sanitized.mdb
ASKER CERTIFIED SOLUTION
Avatar of fhlio_admin
fhlio_admin
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
FWIW,

Based on fhlio_admin's post, I would recommend that you:
1. Partner with a DBA to help you sort through your database, making sure you have a solid idea of how it functions.
2. As a patch you should be able to modify fhlio_admin's original post in some way that will get you what you need.

JeffCoachman
Thanks for the suggestions.

Commenting and cleaning up is long overdue, so I'm going to start there. I'll post a new question once I have cleaned up and commented the existing code better.

As far as the database, I understand the relationships and everything that go with it. I'm having more of a problem adjusting to the VBA way of doing things.
Thanks, you have been a great help in my effort to get things back on track
jondecker76,

"As far as the database, I understand the relationships and everything that go with it. I'm having more of a problem adjusting to the VBA way of doing things."
That is what I meant in my post. I did not, in any way, mean to suggest that you did not understand how the database was strutured.
I meant no offense
;-)

JeffCoachman