Easier Code for Multi-Select List Box

ericx1 · #1 (**permalink**) 01-11-12, 12:25

Good Morning,

I have a Listbox as a subform. This list box allows the users to select a Category an event falls under, which could be several types. The listbox selections are populated by a query.

The subform itself has its recordsource as a link table, between my primary data entry table and the category type table. I have come up with the following code to, On Current Event select the types that are stored for the event.
Then when a user clicks on the subform to select/deselect a type, it creates a record in the table or deletes a record in the table accordingly. It works without any issues so far, however my curiosity has gotten the better of me and I would like to know if there are better ways of coding this functionality.

Code:

Private Sub Form_Current()
    Dim intCurrentRow As Long
    Dim x As String
    Dim strPresent As String
    On Error Resume Next
    
    For intCurrentRow = 0 To Me.List_CategoryType.ListCount - 1
        Me.List_CategoryType.Selected(intCurrentRow) = False
    Next intCurrentRow
    With Me.RecordsetClone
        .MoveFirst
        Do While .EOF = False
            For intCurrentRow = 0 To Me.List_CategoryType.ListCount - 1
                If CInt(Me.List_CategoryType.ItemData(intCurrentRow)) = .EventCategoryTypeID Then
                    Me.List_CategoryType.Selected(intCurrentRow) = True
                End If
            Next intCurrentRow
            .MoveNext
        Loop
        .Close
    End With
End Sub

Private Sub List_CategoryType_AfterUpdate()
    Dim intCurrentRow As Long
    Dim strPresent As String
    Dim x As String
    On Error Resume Next
    
    For intCurrentRow = 0 To Me.List_CategoryType.ListCount - 1
        If Me.List_CategoryType.Selected(intCurrentRow) = True Then
            With Me.RecordsetClone
                .MoveFirst
                If .EOF = True Then
                    .AddNew
                    !EventID = [link_EventID]
                    !EventCategoryTypeID = Me.List_CategoryType.ItemData(intCurrentRow)
                    .Update
                    .Close
                Else
                    Do While .EOF = False
                        If .EventCategoryTypeID <> CInt(Me.List_CategoryType.ItemData(intCurrentRow)) Then
                            .AddNew
                            !EventID = [link_EventID]
                            !EventCategoryTypeID = Me.List_CategoryType.ItemData(intCurrentRow)
                            .Update
                            .Close
                        End If
                        .MoveNext
                    Loop
                End If
                .Close
            End With
        Else
            With Me.RecordsetClone
                .MoveFirst
                Do While .EOF = False
                    If .EventCategoryTypeID = CInt(Me.List_CategoryType.ItemData(intCurrentRow)) Then
                        .Delete
                        !EventID = CInt([link_EventID])
                        !EventCategoryTypeID = CInt(Me.List_CategoryType.ItemData(intCurrentRow))
                        .Update
                    End If
                    .MoveNext
                Loop
                .Close
            End With
        End If
    Next intCurrentRow
    Me.List_CategoryType.Requery
End Sub

Thanks for your Thoughts, Time and Knowledge!

Internet Services

Web Development

Digital Marketing

Consumer Tech