Subform doesn't update with new data added on the fly

Question

I'm having real trouble getting a subform to display the latest data when the data is added while the form is open (via an Append query).

A quick explanation of the tables/forms/VBA & SQL relevant to the problem:
I have three tables which record the teams within my department, the job roles available in the teams and the total number of positions available for each role.

The tables are:

Teams: TeamID (AutoNum, PK), TeamName (Text), CostCode (Text)
Roles: RoleID (AutoNum, PK), RoleDesc (Text), Abbrev (Text)
Team_Composition: TeamID (Num, PK), RoleID (Num, PK), RoleCount (Num)

The form is as below with TeamID linking the Master/Child fields :

The RecordSource for the main form is to the Teams table.
The RecordSource for the subform is a query which allows the user to enter the required numbers for each role in each team in the RoleCount field:

SELECT    Team_Composition.TeamID
        , Roles.RoleDesc
        , Roles.Abbrev
        , Team_Composition.RoleCount
FROM    Team_Composition INNER JOIN Roles ON Team_Composition.RoleID = Roles.RoleID
WHERE   Team_Composition.TeamID=[Forms]![Edit_Teams]![cmbTeamName]

The Team Name combo box on the main form gets it's data from the Teams table with the addition of < New Team > as the first item in the list (the SingleRecord table is just that - a table with 1 field and 1 record so the SELECT will work):

SELECT DISTINCT     0 AS TeamID
                    , '<New Team>' AS TeamName 
FROM                SingleRecord  

UNION ALL SELECT    TeamID
                    , TeamName 
FROM                Teams 
ORDER BY            TeamName

This all works very well when everything already exists on opening the form. I can change the value in the combo box and VBA code fires to move to that record and display the linked data in the subform. I can then add the totals for each team.

The code that moves to the correct record is as below:

'----------------------------------------------------------------------------------
' Procedure : cmbTeamName_AfterUpdate
' Author    : Darren Bartrup-Cook
' Date      : 12/06/2017
' Purpose   : Keeps the details on the form in sync with the team selected in the combo box.
'             Ensures all teams have all roles available to them by updating the team_composition
'             table with new roles whenever the team is selected.
'-----------------------------------------------------------------------------------
Private Sub cmbTeamName_AfterUpdate()

    'The first item in cmbTeamName is <New Team> which will not exist in the recordset.
    'To avoid FindFirst going to the wrong record an attempt is made to create a new record
    'allowing the form to filter to a non-existant record.
    If cmbTeamName = 0 Then
        DoCmd.GoToRecord , , acNewRec
    Else
        Dim rs As DAO.Recordset
        Set rs = Me.RecordsetClone
        rs.FindFirst "[TeamID]=" & cmbTeamName
        If Not (rs.BOF And rs.EOF) Then
            Me.Recordset.Bookmark = rs.Bookmark
        End If
        rs.Close
        Set rs = Nothing

        If cmbTeamName <> 0 Then
            Update_TeamComposition cmbTeamName.Column(1)
        End If

    End If

End Sub

The Update_TeamComposition procedure executes an SQL statement to ensure the team has an up to date list of roles available:

Private Sub Update_TeamComposition(TeamName As String)

    With DoCmd
        .SetWarnings False
        .RunSQL "INSERT INTO Team_Composition(TeamID, RoleID) " & _
                     "SELECT TeamID, RoleID " & _
                     "FROM Teams, Roles " & _
                     "WHERE TeamID = (SELECT TeamID FROM Teams WHERE TeamName='" & TeamName & "')"
        .SetWarnings True
    End With

End Sub

Now for the problem code (or at least where I think the problem is):
When a new team is added to the combo-box it is inserted into the Teams table and the various roles are also added to the Team_Composition table. This works - I can open the table and see the records in there, but the subform refuses to update and show the new records. The database ID is showing 1. The record count at the bottom of the form shows record 1 of 6 even though this is the 7th record I've added - the Teams table shows 7 records and the Team_Composition table shows that the roles have been added to Team ID 7.

The VBA to add a new team is below:

Private Sub cmbTeamName_NotInList(NewData As String, Response As Integer)
    With DoCmd
        .SetWarnings False
        If cmbTeamName.OldValue = 0 Then
            'A new team needs adding to the Team table.
            .RunSQL "INSERT INTO Teams(TeamName) VALUES ('" & NewData & "')"
            Response = acDataErrAdded
            'The job roles for the team are inserted.
            Update_TeamComposition NewData
        Else
            .RunSQL "UPDATE Teams SET TeamName = '" & NewData & "'" & _
                    "WHERE TeamID = " & cmbTeamName.Column(0)
            Response = acDataErrAdded
        End If
        .SetWarnings True
    End With
End Sub

I've tried adding code just before the Else statement to refresh the form - Me.Refresh, Me.Requery, Me.Repaint.

Me.Requeryand Me.Refresh causes the NotInList code to run multiple times and eventually gives run-time 2237 - The text you entered isn't an item in the list (on the Me. line). Me.Repaint doesn't appear to do anything.

I think I've included everything - does anyone know how I can get the subform to populate with roles when a new team is added? To me it looks like the table indexes aren't updated and the form doesn't recognise a new record has been created.

Edit:
After advice from @June7 I've updated my NotInList code to:

Private Sub cmbTeamName_NotInList(NewData As String, Response As Integer)
    With DoCmd
        .SetWarnings False
        If Me.cmbTeamName.OldValue = 0 Then
            'A new team needs adding to the Team table.
            .RunSQL "INSERT INTO Teams(TeamName) VALUES ('" & NewData & "')"
            Response = acDataErrAdded
            'The job roles for the team are inserted.
            Update_TeamComposition NewData

            'To stop the Requery from making NotInList fire multiple times
            'the combo box is moved to a team that does exist before the requery.
            'Then it can move to the new record.
            Me.cmbTeamName = Me.cmbTeamName.ItemData(0)
            Me.Requery

            Dim rs As DAO.Recordset
            Set rs = Me.RecordsetClone
            rs.FindFirst "[TeamName]='" & NewData & "'"
            Me.Recordset.Bookmark = rs.Bookmark
            rs.Close
            Set rs = Nothing

            Me.cmbTeamName.Requery
            Me.cmbTeamName = CLng(Me.txtTeamID)

        Else
            .RunSQL "UPDATE Teams SET TeamName = '" & NewData & "'" & _
                    "WHERE TeamID = " & Me.cmbTeamName.OldValue
            Response = acDataErrAdded
        End If
        .SetWarnings True
    End With
End Sub

I've also updated the SQL for the subform by removing the WHERE clause allowing the form to make use of the Master/Child link.

June7 June7 · Accepted Answer · 2017-06-13T18:46:56

Why bind the main form if you don't take advantage of the Master/Child linking of form/subform? The subform RecordSource has filter criteria referencing the combobox. Well, if the combobox has TeamID of 0 then no associated Team_Composition records exist. Suggest you use Master/Child links properties of subform container instead of the dynamic filter parameter in query. I NEVER use dynamic parameterized queries.

After adding new records to both tables, requery the main form (which should also requery the subform at the same time). However, since requery sets focus on first record, also need to move to the record just created on main form (at the end if ordering by TeamID) or set the sort order to TeamID DESCENDING or use the RecordsetClone and Bookmark code.

It is possible to create a < New Team > line in the combobox RowSource UNION query without the SingleRecord table.

SELECT 0 As TeamID, "<New Team>" AS TeamName FROM Teams
UNION SELECT TeamID, TeamName FROM Teams ORDER BY TeamName;

If source table has no records (as when db is first deployed), the combobox list will be empty. A workaround is to use another table that is guaranteed to have records (a system table will work, I used MSysObjects) as the source for the dummy item.

SELECT 0 As TeamID, "<New Team>" AS TeamName FROM MSysObjects
UNION SELECT TeamID, TeamName FROM Teams ORDER BY TeamName;

Subform doesn't update with new data added on the fly

1 Answers