How do I select items using dual list boxes?

Option Compare Database
Option Explicit

' Description:
' This form demonstrates how to use a pair of list boxes to select any number
' of items from a list. The list boxes MUST have their RowSourceType property
' set to "Value list", and must have the same value for the ColumnCount property.

' For demonstration purposes, create a form with two list boxes named
' lstAvailable and lstSelected, and four command buttons named cmdSelect,
' cmdSelectAll, cmdDeselect, and cmdDeselectAll. Then paste this code into
' the form module, verify that the necessary event properties are set to
' "[Event Procedure]", and run it.

' Sample data for the "available" and "selected" list boxes. This data is for
' two-column list boxes. For single-column list boxes, remove the digits and
' the following semicolons.
Const List1 = "Atlanta;1;Philadelphia;2;Denver;3;" _
    & "Los Angeles;4;Houston;5;New York;6;Cincinnati;7;" _
    & "Phoenix;8;Seattle;9;Chicago;10;Washington;11;Boston;12;Kansas City;13"
Const List2 = ""

Private Sub cmdDeselect_Click()
    ' The button received the focus when it was clicked. If we move the last
    ' item in the list, this button must be disabled, but you can't disable a
    ' button when it has the focus, so always set the focus to the list box.
    ' We do much the same thing for the other command buttons.
    lstSelected.SetFocus
    DeselectItem
End Sub

Private Sub cmdDeselectAll_Click()
    lstSelected.SetFocus
    DeselectAllItems
End Sub

Private Sub cmdSelect_Click()
    lstAvailable.SetFocus
    SelectItem
End Sub

Private Sub cmdSelectAll_Click()
    lstAvailable.SetFocus
    SelectAllItems
End Sub

Private Sub Form_Close()
' This is just demonstration code to show how you would retrieve an array of
' the selected items.
    Dim astrSelected As Variant
    
    astrSelected = Split(lstSelected.RowSource, ";")
    'MsgBox "Items selected: " & vbCrLf & Join(astrSelected, vbCrLf)
End Sub

Private Sub Form_Open(Cancel As Integer)
    ' Load the list boxes. In a real-world application you would probably not
    ' use constants, but would build up the list of semicolon-separated items
    ' in a string.
    LoadList lstAvailable, List1
    LoadList lstSelected, List2
    ResetButtons
End Sub

Private Sub lstAvailable_DblClick(Cancel As Integer)
' Double-clicking an item in a list moves it to the other list
    SelectItem
End Sub

Private Sub lstSelected_DblClick(Cancel As Integer)
    DeselectItem
End Sub

Private Sub SelectItem()
    MoveItem lstAvailable, lstSelected
    ResetButtons
End Sub

Private Sub SelectAllItems()
    MoveAllItems lstAvailable, lstSelected
    ResetButtons
End Sub

Private Sub DeselectItem()
    MoveItem lstSelected, lstAvailable
    ResetButtons
End Sub

Private Sub DeselectAllItems()
    MoveAllItems lstSelected, lstAvailable
    ResetButtons
End Sub

Private Sub ResetButtons()
' This procedure enables or disables the command buttons. Buttons that move
' items out of a list are disabled if the list is empty, else they are enabled.
    cmdSelect.Enabled = lstAvailable.ListCount > 0
    cmdSelectAll.Enabled = cmdSelect.Enabled
    cmdDeselect.Enabled = lstSelected.ListCount > 0
    cmdDeselectAll.Enabled = cmdDeselect.Enabled
End Sub

' The following procedures are parameterized to make them independent of any
' form. If you want to use the dual list box method in multiple forms, you
' could make these procedures Public and put them in a standard module. That
' would make the database smaller and let the forms load faster.

Private Sub MoveItem(FromListBox As ListBox, ToListBox As ListBox)
' Moves an item from the FromListBox to the ToListBox. After the move, the
' moved item is selected in the 'to' list box, and the item following the
' moved item, if there is one, is selected in the 'from' list box (otherwise
' the first item is selected).
    Dim nCols As Integer        ' Number of columns in each list box
    Dim iFrom As Integer        ' Index of current item in source list box
    Dim iTo As Integer          ' Index of current item in target list box
    Dim astrFrom As Variant     ' Array of strings from source RowSource
    Dim astrTo As Variant       ' Array of strings from target RowSource
    Dim i As Integer
    
    ' Check that some item is selected in the source list box. (If no item is
    ' selected, the ListIndex property is -1.)
    If FromListBox.ListIndex < 0 Then Exit Sub
    
    nCols = FromListBox.ColumnCount
    
    ' Unload the list box contents into string arrays. If the list boxes have
    ' multiple columns, the arrays will contain the values from R0C0, R0C1,
    ' R0C2, ... R1C0, R1C1, R1C2, etc.
    astrFrom = Split(FromListBox.RowSource, ";")
    ' Note: For the target list box, we append extra ";"s to the RowSource
    ' property so that Split() will create entries for an extra item. This
    ' keeps us from having to resize the array to make room for the new item.
    astrTo = Split(ToListBox.RowSource & String(nCols, ";"), ";")
    
    ' Copy the columns of the selected item to the extra item at the end of
    ' the target array.
    iFrom = FromListBox.ListIndex
    iTo = ToListBox.ListCount
    For i = 0 To nCols - 1
        astrTo(iTo * nCols + i) = astrFrom(iFrom * nCols + i)
    Next i
    
    ' Delete the selected item from the source list by shifting any
    ' remaining items down in the array.
    For i = iFrom * nCols To UBound(astrFrom) - nCols
        astrFrom(i) = astrFrom(i + nCols)
    Next i
    
    ' Resize the source array to eliminate the extra item at the end. Note
    ' that the source array may have been emptied; if it is, set it to an
    ' empty array. (ReDim will not create an empty array.)
    If i = 0 Then
        astrFrom = Array()
    Else
        ReDim Preserve astrFrom(i - 1)
    End If
    
    LoadList FromListBox, Join(astrFrom, ";"), iFrom
    LoadList ToListBox, Join(astrTo, ";"), iTo
End Sub

Private Sub MoveAllItems(FromListBox As ListBox, ToListBox As ListBox)
' Moves all items from the FromListBox to the ToListBox. After the move,
' the first item is selected in the 'to' list box.
    Dim nCols As Integer        ' Number of columns in each list box
    Dim nRows As Integer        ' Number of rows in source list box
    Dim iTo As Integer          ' Index of current item in target list box
    Dim astrFrom As Variant     ' Array of strings from source RowSource
    Dim astrTo As Variant       ' Array of strings from target RowSource
    Dim i As Integer
    
    nCols = FromListBox.ColumnCount
    nRows = FromListBox.ListCount
    
    ' Check that the source list box is not empty
    If nRows = 0 Then Exit Sub
    
    ' Unload the list box contents into string arrays. If the list boxes have
    ' multiple columns, the arrays will contain the values from R0C0, R0C1,
    ' R0C2, ... R1C0, R1C1, R1C2, etc.
    astrFrom = Split(FromListBox.RowSource, ";")
    ' Note: For the target list box, we append extra ";"s to the RowSource
    ' property so that Split() will create extra entries for the items to be
    ' moved. This keeps us from having to resize the array to make room for
    ' the new items.
    astrTo = Split(ToListBox.RowSource & String(nRows * nCols, ";"), ";")
    
    ' Copy the 'from' list box items to the extra items at the end of the
    ' target array.
    iTo = ToListBox.ListCount * nCols
    For i = 0 To nRows * nCols - 1
        astrTo(iTo + i) = astrFrom(i)
    Next i
    
    LoadList FromListBox, ""
    LoadList ToListBox, Join(astrTo, ";"), iTo
End Sub

Private Sub LoadList(ListBox As ListBox, Items As String, _
                     Optional SelectedItem As Integer = 0)
' This procedure loads a list box from a string containing a value list, and
' attempts to make the SelectedItem selected. If SelectedItem is invalid, the
' first item in the list is selected instead.
    With ListBox
        .RowSource = Items
        If SelectedItem < 0 Or SelectedItem >= .ListCount Then _
            SelectedItem = 0
        
        ' If the BoundColumn property is set to 0, you select an item by
        ' setting the list box's value to the desired item number. Otherwise,
        ' you set it to the value of the bound column for the desired item.
        If .BoundColumn = 0 Then
            .Value = SelectedItem
        Else
            .Value = .ItemData(SelectedItem)
        End If
    End With
End Sub