'----- start of code ----- 
Option Compare Database 
Option Explicit 

Private Sub ClearHobbySelections() 

    Dim intI As Integer 

    With Me.lstHobbies 
        For intI = (.ItemsSelected.Count - 1) To 0 Step -1 
            .Selected(.ItemsSelected(intI)) = False 
        Next intI 
    End With 

End Sub 

Private Sub Form_Current() 

    Dim rs As DAO.Recordset 
    Dim intI As Integer 

    ' Clear all currently selected hobbies. 
    ClearHobbySelections 

    If Not Me.NewRecord Then 

        Set rs = CurrentDb.OpenRecordset( _ 
            "SELECT HobbyID FROM tblFamilyMembersHobbies " & _ 
                "WHERE MemberID=" & Me.MemberID) 

        ' Select the hobbies currently on record for this MemberID. 
        With Me.lstHobbies 
            Do Until rs.EOF 
                For intI = 0 To (.ListCount - 1) 
                    If .ItemData(intI) = CStr(rs!HobbyID) Then 
                        .Selected(intI) = True 
                        Exit For 
                    End If 
                Next intI 
                rs.MoveNext 
            Loop 
            rs.Close 
            Set rs = Nothing 
        End With 

    End If 

End Sub 

Private Sub lstHobbies_AfterUpdate() 

    On Error GoTo Err_lstHobbies_AfterUpdate 

    Dim db As DAO.Database 
    Dim ws As DAO.Workspace 
    Dim strSQL As String 
    Dim blnInTransaction As Boolean 
    Dim varItem As Variant 

    ' Make sure the current member record has been saved. 
    If Me.Dirty Then Me.Dirty = False 

    Set ws = Workspaces(0) 
    Set db = ws.Databases(0) 

    ws.BeginTrans 
    blnInTransaction = True 

    ' Delete all hobbies now on record. 
    strSQL = "DELETE FROM tblFamilyMembersHobbies " & _ 
                "WHERE Memberid = " & Me.MemberID 

    db.Execute strSQL, dbFailOnError 

    ' Add each hobby selected in the list box. 
    With Me.lstHobbies 
        For Each varItem In .ItemsSelected 
            strSQL = _ 
                "INSERT INTO tblFamilyMembersHobbies " & _ 
                    "(MemberID, HobbyID) VALUES (" & _ 
                    Me.MemberID & ", " & .ItemData(varItem) & ")" 
            db.Execute strSQL, dbFailOnError 
        Next varItem 
    End With 

    ws.CommitTrans 
    blnInTransaction = False 

Exit_lstHobbies_AfterUpdate: 
    Set db = Nothing 
    Set ws = Nothing 
    Exit Sub 

Err_lstHobbies_AfterUpdate: 
    MsgBox "Error " & Err.Number & ": " & Err.Description, _ 
        vbExclamation, "Unable to Update" 
    If blnInTransaction Then 
        ws.Rollback 
        blnInTransaction = False 
    End If 
    Resume Exit_lstHobbies_AfterUpdate 

End Sub 

Private Sub lstHobbies_BeforeUpdate(Cancel As Integer) 

    Dim intI As Integer 

    ' Don't allow hobbies to be updated before a MemberID has 
    ' been generated. 
    If IsNull(Me.MemberID) Then 
        MsgBox "Please enter other information for this family " & _ 
            "member before choosing hobbies.", , _ 
            "Define Member First" 
        Cancel = True 
        Me.lstHobbies.Undo 
        ' Clear the user's selection. 
        ClearHobbySelections 
    End If 

End Sub 
'----- end of code -----