Transferring Data from One List Box to another on the same form

Transferring Data from One List Box to another on the same form

If you want to allow the user to select data in one list box, and transfer the selected items to another list box, as the wizards do, then you can use some code like that below. This example is based on the Products table in the Northwind sample database.

First, start by creating a new form, and adding two list box controls to it, called lstOne and lstTwo. Next, add five command buttons, and call these cmdOneToTwo, cmdOneToTwoAll, cmdTwoToOne, cmdTwoToOneAll and cmdClear.

Next add the following code to the form's module:

Option Compare Database
Option Explicit

Const strRowSource1 = "SELECT ProductID, ProductName FROM Products "
Const strRowSource2 = " ORDER BY ProductName ASC;"
Const strRowSource3 = " WHERE ProductID IN("

Private Sub cmdClear_Click()
    Form_Load
End Sub

Private Sub cmdOneToTwo_Click()
    Dim strSQLOne As String, strSQLTwo As String, strDummy As String
    Dim intLoop As Integer
    For intLoop = 0 To Me!lstOne.ListCount - 1
        If Me!lstOne.Selected(intLoop) = False Then
            strSQLOne = strSQLOne & Me!lstOne.ItemData(intLoop) & ","
        Else
            strSQLTwo = strSQLTwo & Me!lstOne.ItemData(intLoop) & ","
        End If
    Next intLoop
    If Len(strSQLOne) > 0 Then strSQLOne = Left(strSQLOne, Len(strSQLOne) - 1)
    If Len(strSQLTwo) > 0 Then
        strSQLTwo = Left(strSQLTwo, Len(strSQLTwo) - 1)
        If Len(Me!lstTwo.RowSource) = 0 Then
            strSQLOne = strRowSource1 & strRowSource3 & strSQLOne & ")" & strRowSource2
            strSQLTwo = strRowSource1 & strRowSource3 & strSQLTwo & ")" & strRowSource2
            Me!lstOne.RowSource = strSQLOne
            Me!lstTwo.RowSource = strSQLTwo
        Else
            strSQLOne = strRowSource1 & strRowSource3 & strSQLOne & ")" & strRowSource2
            strDummy = Mid(Me!lstTwo.RowSource, InStr(Me!lstTwo.RowSource, "(") + 1)
            strDummy = Left(strDummy, InStr(strDummy, ")") - 1)
            strDummy = strRowSource1 & strRowSource3 & strSQLTwo & "," & strDummy & ")" & strRowSource2
            Me!lstTwo.RowSource = strDummy
            Me!lstOne.RowSource = strSQLOne
        End If
    End If
End Sub

Private Sub cmdOneToTwoAll_Click()
    Me!lstTwo.RowSource = strRowSource1 & strRowSource2
    Me!lstOne.RowSource = ""
End Sub

Private Sub cmdTwoToOne_Click()
    Dim strSQLOne As String, strSQLTwo As String, strDummy As String
    Dim intLoop As Integer
    For intLoop = 0 To Me!lstTwo.ListCount - 1
        If Me!lstTwo.Selected(intLoop) = False Then
            strSQLTwo = strSQLTwo & Me!lstTwo.ItemData(intLoop) & ","
        Else
            strSQLOne = strSQLOne & Me!lstTwo.ItemData(intLoop) & ","
        End If
    Next intLoop
    If Len(strSQLTwo) > 0 Then strSQLTwo = Left(strSQLTwo, Len(strSQLTwo) - 1)
    If Len(strSQLOne) > 0 Then
        strSQLOne = Left(strSQLOne, Len(strSQLOne) - 1)
        If Len(Me!lstOne.RowSource) = 0 Then
            strSQLOne = strRowSource1 & strRowSource3 & strSQLOne & ")" & strRowSource2
            strSQLTwo = strRowSource1 & strRowSource3 & strSQLTwo & ")" & strRowSource2
            Me!lstOne.RowSource = strSQLOne
            Me!lstTwo.RowSource = strSQLTwo
        Else
            strSQLTwo = strRowSource1 & strRowSource3 & strSQLTwo & ")" & strRowSource2
            strDummy = Mid(Me!lstOne.RowSource, InStr(Me!lstOne.RowSource, "(") + 1)
            strDummy = Left(strDummy, InStr(strDummy, ")") - 1)
            strDummy = strRowSource1 & strRowSource3 & strSQLOne & "," & strDummy & ")" & strRowSource2
            Me!lstOne.RowSource = strDummy
            Me!lstTwo.RowSource = strSQLTwo
        End If
    End If
End Sub

Private Sub cmdTwoToOneAll_Click()
    Me!lstTwo.RowSource = ""
    Me!lstOne.RowSource = strRowSource1 & strRowSource2
End Sub

Private Sub Form_Load()
    Me!lstOne.RowSource = strRowSource1 & strRowSource2
    Me!lstTwo.RowSource = ""
End Sub

You can download an Access 97 database that has this example in.

Top

Last modified at 06/06/2006 14:54:29