Add to one list and delete from another

[ccordner]

I'm trying to create a standard listbox, with the option to move items from one to another.

As you can imagine, I have a button with the following code:

With lstLocations

    For lngListCount = 0 To .ListCount - 1
    
        If .Selected(lngListCount) = True Then
        
            Call AddEntry("lstList1", .List(lngListCount))
            .RemoveItem (lngListCount)
        
        End If
        
    Next

End With

It checks which items are selected, adds them to the list box (using the subroutine AddEntry), but the problem comes when you remove the item - the list is now shorter, so of course it's looking for an entry that doesn't exist.

Any ideas how I can deal with this?

 

[richh]

Hi ccordner,

This is the solution I use in one of my userforms. The user must select a topic in one listbox, hit the Select button, and it will move it to the other list box.

Private Sub addTopic_Click()
    Dim uniqueFlag As Boolean
    
    uniqueFlag = True
    
    With Me
        For x = 0 To .availableTopics.ListCount - 1
            If .availableTopics.Selected(x) Then
                For y = 0 To .selectedTopics.ListCount - 1
                    If .selectedTopics.List(y) = .availableTopics.List(x) Then
                        uniqueFlag = False
                    End If
                Next y
                
                If uniqueFlag Then
                    .selectedTopics.AddItem .availableTopics.List(x)
                End If
                
                .availableTopics.Selected(x) = False
                Call AddRemoveAttachments(.availableTopics.List(x), 1)
                
                .availableTopics.RemoveItem (x)
                Exit For
            End If
        Next x
    End With
End Sub

Private Sub removeTopic_Click()
    Dim uniqueFlag  As Boolean
    uniqueFlag = True

    With Me
        For x = 0 To .selectedTopics.ListCount - 1
            If .selectedTopics.Selected(x) Then
                For y = 0 To .availableTopics.ListCount - 1
                    If .availableTopics.List(y) = .selectedTopics.List(x) Then
                        uniqueFlag = False
                    End If
                Next y
                
                If uniqueFlag Then
                    .availableTopics.AddItem .selectedTopics.List(x)
                End If
                
                Call AddRemoveAttachments(.selectedTopics.List(x), 2)
                                
                .selectedTopics.RemoveItem (x)
                Exit For
            End If
        Next x
        
        For x = 0 To .selectedTopics.ListCount - 1
            If .selectedTopics.Selected(x) = True Then
                .selectedTopics.Selected(x) = False
            End If
        Next x
    End With
End Sub