Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Rhinorhino on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Move Items From One Listbox to Another Listbox

List Boxes

Move Items From One Listbox to Another Listbox

by  MajP  Posted    (Edited  )
Here are two methods to create the functionality similar to the form wizard where you can move selected items between list boxes, or move all items between list boxes.

The first example uses a a class module the second uses a standard form module. The class module only requires the user to write 6 lines of code because all functionality is encapsulated in the class. The form module requires the user to include a new table and modify the list box rowsources.

The code works with multi column listboxes, multiselect listboxes, and list boxes built on a value list or query.

The code explains how to use the class. Any feedback would be greatly appreciated.

Class module
Code: 
'Class Module Name: ToFromList
'Developed by: MajP
'
'Purpose: This Class Module takes any two listboxes and four command buttons and allows the user to move items
'back and forth between the list boxes.  This works with multi select list boxes and row source types of value list
'or table/queries
'The four command buttons are assigned to the following purposes:
'CmdBtnMoveFromListOneToListTwo: Move a selected values from list one to list two
'CmdBtnMoveAllFromListOneToListTwo: Moves all values from list one to list two
'CmdBtnMoveFromListTwoToListOne: Moves selected values from list two to list one
'CmdBtnMoveAllFromListTwoToListOne: Moves all values from list two to list one
'
'Use: 
'1. Place this code in a CLASS module named "FromToList"
'2. Ensure that you have a reference to DAO
'3. Construct a form with 2 list boxes, and four command buttons
'4. Instantiate the class something like the following in your form:

'Option Compare Database
'Option Explicit
'Public ftl As FromToList

'Private Sub Form_Load()
'   Set ftl = New FromToList
'   Set ftl.ListBoxOne = Me.lstOne
'   Set ftl.ListBoxTwo = Me.lstTwo
'   Set ftl.CmdBtnMoveFromListOneToListTwo = Me.cmdOne
'   Set ftl.CmdBtnMoveAllFromListOneToListTwo = Me.cmdTwo
'   Set ftl.CmdBtnMoveFromListTwoToListOne = Me.cmdThree
'   Set ftl.CmdBtnMoveAllFromListTwoToListOne = Me.cmdFour
'End Sub
'
'5. This should be all you need for this functionality


Private WithEvents mCmdMoveFromListOneToListTwo As Access.CommandButton
Private WithEvents mCmdMoveFromListTwoToListOne As Access.CommandButton
Private WithEvents mCmdMoveAllFromListOneToListTwo As Access.CommandButton
Private WithEvents mCmdMoveAllFromListTwoToListOne As Access.CommandButton
Private mLstOne As Access.ListBox
Private mLstTwo As Access.ListBox
Private mBlnFromOnly As Boolean

Public Property Set CmdBtnMoveFromListOneToListTwo(ByVal theCmdBtn As Access.CommandButton)
  Set mCmdMoveFromListOneToListTwo = theCmdBtn
  mCmdMoveFromListOneToListTwo.OnClick = "[Event Procedure]"
End Property
Public Property Set CmdBtnMoveFromListTwoToListOne(ByVal theCmdBtn As Access.CommandButton)
  Set mCmdMoveFromListTwoToListOne = theCmdBtn
   mCmdMoveFromListTwoToListOne.OnClick = "[Event Procedure]"
End Property
Public Property Set CmdBtnMoveAllFromListOneToListTwo(ByVal theCmdBtn As Access.CommandButton)
  Set mCmdMoveAllFromListOneToListTwo = theCmdBtn
  mCmdMoveAllFromListOneToListTwo.OnClick = "[Event Procedure]"
End Property
Public Property Set CmdBtnMoveAllFromListTwoToListOne(ByVal theCmdBtn As Access.CommandButton)
  Set mCmdMoveAllFromListTwoToListOne = theCmdBtn
  mCmdMoveAllFromListTwoToListOne.OnClick = "[Event Procedure]"
End Property
Public Property Set ListBoxOne(ByVal theListBox As Access.ListBox)
  Set mLstOne = theListBox
  Call convertToValueList(mLstOne)
End Property
Public Property Set ListBoxTwo(ByVal theListBox As Access.ListBox)
  Set mLstTwo = theListBox
  Call convertToValueList(mLstTwo)
End Property

Public Sub convertToValueList(theListBox As Access.ListBox)
  Dim rs As DAO.Recordset
  Dim strSql As String
  Dim fldField As DAO.Field
  Dim strLstValue As String
  Dim intColCount As Integer
  Dim intColCounter As Integer
  Dim intRowCounter As Integer
  If theListBox.RowSourceType = "Table/Query" Then
    intColCount = theListBox.ColumnCount
    strSql = theListBox.RowSource
    theListBox.RowSource = ""
    Set rs = CurrentDb.OpenRecordset(strSql)
    theListBox.RowSourceType = "Value List"
    Do While Not rs.EOF
       For intColCounter = 0 To intColCount - 1
          strLstValue = strLstValue & """" & CStr(Nz(rs.Fields(intColCounter), " ")) & """;"
       Next intColCounter
       intRowCounter = intRowCounter + 1
       rs.MoveNext
       strLstValue = Left(strLstValue, Len(strLstValue) - 1)
       theListBox.AddItem (strLstValue)
       strLstValue = ""
    Loop
 End If
End Sub
Private Sub moveBetweenLists(lstBoxFrom As Access.ListBox, lstBoxTo As Access.ListBox)
 On Error GoTo err_list
 Dim counter As Integer
 Dim colCounter As Integer
 Dim varListItem As Variant
 Dim indexArray() As Variant
 Dim listValue As String
 Dim intCountSelected As Integer
 ReDim indexArray(0 To lstBoxFrom.listCount)
 For Each varListItem In lstBoxFrom.ItemsSelected
   For colCounter = 0 To lstBoxFrom.ColumnCount - 1
     listValue = listValue & """" & CStr(Nz(lstBoxFrom.Column(colCounter, varListItem), " ")) & """;"
   Next colCounter
   listValue = Left(listValue, Len(listValue) - 1)
   lstBoxTo.AddItem (listValue)
   indexArray(counter) = varListItem
   counter = counter + 1
   listValue = ""
 Next varListItem
 intCountSelected = lstBoxFrom.ItemsSelected.Count
 'remove
  For counter = 0 To intCountSelected - 1
      lstBoxFrom.RemoveItem (indexArray(counter) - counter)
  Next counter
Exit_Sub:
  Exit Sub
err_list:
   MsgBox Err.Description
   Resume Exit_Sub
 Exit Sub
End Sub

Private Sub mCmdMoveAllFromListOneToListTwo_Click()
  Dim counter As Integer
  For counter = 0 To mLstOne.listCount - 1
      mLstOne.Selected(counter) = True
  Next counter
  Call moveBetweenLists(mLstOne, mLstTwo)
End Sub

Private Sub mCmdMoveAllFromListTwoToListOne_Click()
  Dim counter As Integer
  For counter = 0 To mLstTwo.listCount - 1
      mLstTwo.Selected(counter) = True
  Next counter
  Call moveBetweenLists(mLstTwo, mLstOne)
End Sub

Private Sub mCmdMoveFromListOneToListTwo_Click()
   If mLstOne.ListIndex = -1 Then
      MsgBox "No Items Selected"
   End If
  Call moveBetweenLists(mLstOne, mLstTwo)
End Sub
Private Sub mCmdMoveFromListTwoToListOne_Click()
 If mLstTwo.ListIndex = -1 Then
      MsgBox "No Items Selected"
   End If
  Call moveBetweenLists(mLstTwo, mLstOne)
End Sub

Here is another version using only a form module. Someday I will convert this to a class module. This is a little more efficient (I think) because it does not convert a query rowsource to a value list. This version requires the user to create a table called "tblSelected". This table stores the "selected" primary keys. The row sources for the left listbox includes all records not in tblSelected. The right list box includes only the records tblSelected. Follow the instructions carefully, but should involve no additional code on your part

Drop all of the following into a form's module
Code: 
Option Compare Database
Option Explicit'Form Module to make a to from list
'Developed by: MajP
'Last Update:17 May 08
'
'Purpose: This Form Module takes two listboxes and four command buttons and allows the user to move items
'back and forth between the list boxes.  This works with multi select list boxes and row source queries
'This is probably a little more efficient than the class module because it does not really on
'converting the row source to a value list. However, this requires the user to create a table
'and ensure that the listboxes have the primary keys bound.
'
''You database must have the following Table:
'  tblSelected
' tblSelected must have the the following fields:
'  numFK - of number type
'  strFK - of text type
'
'Your form must have the following Controls:
' lstOne - the listbox on the left to select from
' lstTwo - the listbox on the right to move to
' cmdOne - > move highlighted values from lstOne to lstTwo
' cmdTwo - >> move all values from lstOne to lstTwo
' cmdThre - < move highlighted values from lstTwo to lstOne
' cmdFour - << move all values from lstTwo to lstOne
'
'
'lstOne and lstTwo should have the same rowsource and format except for the following:
'In the query for lstOne, in the criteria for the primary key field place the following:
'  If a numeric primary key: "Not In (select numFK from tblSelected)"
'  If a text field primary key: "Not In (select strFK from tblSelected)"
'
'In the query for lstTwo, in the criteria for the primary key field need the following:
'  If a numeric primary key: " IN (select numFK from tblSelected)"
'  If a text field primary key: " IN (select strFK from tblSelected)"
'
'example for lstOne:
'"SELECT tblScouts.ScoutID, tblScouts.strLastName FROM tblScouts
' WHERE tblScouts.autoScoutID
' Not In (select numFK from tblSelected)"
'
'example for lstTwo:
'"SELECT tblScouts.ScoutID, tblScouts.strLastName FROM tblScouts
' WHERE tblScouts.autoScoutID
' IN (select numFK from tblSelected)"


Private Sub cmdFour_Click()
  Call removeAllFromSelected
End Sub


Private Sub cmdOne_Click()
 Call addToSelected
End Sub

Private Sub cmdThree_Click()
  Call removeFromSelected
End Sub

Private Sub cmdTwo_Click()
  addAllToSelected
End Sub
Private Sub Form_Load()
  Dim strSql As String
  strSql = "Delete * from tblSelected"
  DoCmd.SetWarnings (False)
  DoCmd.RunSQL strSql
  DoCmd.SetWarnings (True)
  listRefresh
End Sub
Public Sub removeFromSelected()
  'Ensure that primary key is the bound value of the listbox
  Dim varItem As Variant
  Dim varData As Variant
  For Each varItem In Me.lstTwo.ItemsSelected
    varData = Me.lstTwo.ItemData(varItem)
    Call deleteData(varData, getPrimaryKeyType)
  Next varItem
  Call listRefresh
End Sub
Public Sub addToSelected()
  'Ensure that primary key is the bound value of the listbox
  Dim varItem As Variant
  Dim varData As Variant
  For Each varItem In Me.lstOne.ItemsSelected
    varData = Me.lstOne.ItemData(varItem)
    Call insertData(varData, getPrimaryKeyType)
  Next varItem
  Call listRefresh
End Sub

Public Function getPrimaryKeyType() As String
  Dim rs As DAO.Recordset
  Set rs = Me.lstOne.Recordset
  Select Case rs.Fields(0).Type
    Case 10
      getPrimaryKeyType = "Text"
    Case 4, 16, 9, 20, 7, 15
      getPrimaryKeyType = "Number"
    Case Else
      MsgBox "Error with primary key.  Check that primary key is bound field of listbox"
    End Select
End Function
Public Sub insertData(varData As Variant, primaryKeyType As String)
  Dim strSql As String
  If primaryKeyType = "Text" Then
      strSql = "insert into tblSelected (strFK) values('" & varData & "')"
  Else
      strSql = "insert into tblSelected (numFK) values(" & varData & ")"
  End If
  DoCmd.SetWarnings (False)
  DoCmd.RunSQL strSql
  DoCmd.SetWarnings (True)
  
End Sub
Public Sub addAllToSelected()
  Dim lstItem As Integer
  For lstItem = 0 To lstOne.ListCount - 1
    lstOne.Selected(lstItem) = True
  Next lstItem
  addToSelected
End Sub
Public Sub removeAllFromSelected()
  Dim lstItem As Integer
  For lstItem = 0 To lstTwo.ListCount - 1
    lstTwo.Selected(lstItem) = True
  Next lstItem
  removeFromSelected
End Sub

Public Sub listRefresh()
  lstOne.RowSource = lstOne.RowSource
  lstTwo.RowSource = lstTwo.RowSource
End Sub
Public Sub deleteData(varData As Variant, primaryKeyType As String)
  Dim strSql As String
  If primaryKeyType = "Text" Then
      strSql = "delete * from tblSelected where strFK = '" & varData & "'"
  Else
      strSql = "delete * from tblSelected where numFK = " & varData
  End If
  DoCmd.SetWarnings (False)
  DoCmd.RunSQL strSql
  DoCmd.SetWarnings (True)
End Sub
Register to add this FAQ to your archive
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top