Results 1 to 9 of 9
  1. #1
    haggis999 is offline Advanced Beginner
    Windows 10 Office 365
    Join Date
    Nov 2012
    Location
    Southampton, UK
    Posts
    60

    Question Looking for code samples for moving items between 2 multiselect listboxes

    The attached screen shot shows a form I am developing for selecting keywords to assign to old photos (negatives and slides). The interface is not uncommon but I am struggling to find good code samples that will let me move items from a multiselect source listbox to a multiselect destination listbox. I've got this working with single selections (using AddItem and RemoveItem) but trying to move multiple selections at the same time screws things up and the wrong items are moved.



    I also want to move items back from the destination listbox to the source listbox.

    My keywords are split into 4 groups (PEOPLE, EVENTS, PLACES and OTHER) and each of these has its own source listbox on a separate tab of a tabcontrol. Ideally, I want the destination listbox items to be sorted alphabetically within keyword group but am not quite sure how to do that. At present, the items are listed in the order in which they were selected. The screen shot is a simplified version that was created for the purposes of this forum post. My real database has source listboxes that are much longer (up to 250 keywords), so I need an efficient solution that will run reasonably quickly.

    Can anyone point me towards a good example of how all this could be done?
    Attached Thumbnails Attached Thumbnails Capture.PNG  

  2. #2
    ranman256's Avatar
    ranman256 is online now VIP
    Windows Vista Access 2010 32bit
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    9,521
    dont use multiselect, it requires vb code.
    instead, use the list to dbl-click, which runs 1 append query to add the item to the tPickedList table.
    simple.

  3. #3
    accesstos's Avatar
    accesstos is offline Expert
    Windows XP Access 2007
    Join Date
    Dec 2018
    Location
    Greece
    Posts
    551
    Quote Originally Posted by haggis999 View Post
    Can anyone point me towards a good example of how all this could be done?
    Recently I created a form similar to yours for personal use. This is the code for moving items:
    Code:
    Option Compare Database
    Option Explicit
    '
    
    Private Sub cmdAdd_Click()
        Dim i As Variant
    
        If IsNull(Me!ID) Then
        Else
            With Me.lstAvail
                If .ItemsSelected.Count = 0 Then
                    If .ListCount = 1 Then
                        i = 0                                               'Add the last in list. No need to select it.
                    Else
                        i = Null
                    End If
                Else
                    i = .ItemsSelected(0)
                End If
    
                If IsNull(i) Then
                Else
                    On Error Resume Next
                    i = .ItemsSelected(0)
                    CurrentDb.Execute "INSERT INTO tblSiteAccounts (siteID_FK, accID_FK) " _
                                      & "VALUES(" & .ItemData(i) _
                                      & ", " & Me!ID & ")", dbFailOnError
                    If Err Then
                        MsgBox "Error #" & Err & vbCrLf & Err.Description, vbCritical, Me.Caption
                        Err.Clear
                    Else
                        Me.lstAdded.Requery
                        .Selected(i) = False
                        .Requery
                    End If
                End If
            End With
        End If
    End Sub
    
    Private Sub cmdAddAll_Click()
        Dim i As Variant
    
        If IsNull(Me!ID) Then
        Else
            With Me.lstAvail
                If .ItemsSelected.Count = 0 Then
                    If .ListCount = 1 Then
                        cmdAdd_Click                                        'Add the last in list. No need to select it.
                    End If
                Else
    
                    For Each i In .ItemsSelected
                        On Error Resume Next
                        CurrentDb.Execute "INSERT INTO tblSiteAccounts (siteID_FK, accID_FK) " _
                                          & "VALUES(" & .ItemData(i) & ", " & Me!ID & ")", dbFailOnError
                    Next i
                    Me.lstAdded.Requery
                    For Each i In .ItemsSelected
                        .Selected(i) = False
                    Next i
                    .Requery
                End If
            End With
        End If
    End Sub
    
    Private Sub cmdRemove_Click()
        Dim i As Variant
    
        If IsNull(Me!ID) Then
        Else
            With Me.lstAdded
                If .ItemsSelected.Count = 0 Then
                    If .ListCount = 1 Then
                        i = 0                                               'Remove the last in list. No need to select it.
                    Else
                        i = Null
                    End If
                Else
                    i = .ItemsSelected(0)
                End If
    
                If IsNull(i) Then
                Else
                    On Error Resume Next
                    'Remove the first selected from the tblSiteAccounts
                    CurrentDb.Execute "DELETE * FROM tblSiteAccounts " _
                                      & "WHERE siteID_FK=" & .ItemData(i) _
                                      & " AND accID_FK=" & Me!ID, dbFailOnError
                    If Err Then
                        MsgBox "Error #" & Err & vbCrLf & Err.Description, vbCritical, Me.Caption
                        Err.Clear
                    Else
                        Me.lstAvail.Requery
                        .Selected(i) = False
                        .Requery
                    End If
                End If
            End With
        End If
    End Sub
    
    Private Sub cmdRemoveAll_Click()
        Dim i As Variant
    
        If IsNull(Me!ID) Then
        Else
            With Me.lstAdded
                If .ItemsSelected.Count = 0 Then
                    If .ListCount = 1 Then
                        cmdRemove_Click                                     'Add the last in list. No need to select it.
                    End If
                Else
                    For Each i In .ItemsSelected
                        On Error Resume Next
                        CurrentDb.Execute "DELETE * FROM tblSiteAccounts " _
                                          & "WHERE siteID_FK=" & .ItemData(i) _
                                          & " AND accID_FK=" & Me!ID, dbFailOnError
                    Next i
                    Me.lstAvail.Requery
                    For Each i In .ItemsSelected
                        .Selected(i) = False
                    Next i
                    .Requery
                End If
            End With
        End If
    End Sub
    
    Private Sub Form_Current()
        With Me.ID
            If IsNull(.Value) Then
                Me.lstAvail.RowSource = ""
                Me.lstAdded.RowSource = ""
            Else
                Me.lstAvail.RowSource = "SELECT DISTINCT S.siteID, S.siteName " _
                                        & "FROM tblSites AS S " _
                                        & "LEFT JOIN (SELECT * FROM tblSiteAccounts " _
                                        & "WHERE AccID_FK=" & .Value & ") AS A " _
                                        & "ON S.siteID = A.SiteID_FK " _
                                        & "WHERE A.AccID_FK Is Null " _
                                        & " ORDER BY siteName"
                Me.lstAdded.RowSource = "SELECT DISTINCT siteID, siteName " _
                                        & "FROM qrySiteAccounts " _
                                        & "WHERE AccID_FK=" & .Value _
                                        & " ORDER BY siteName"
            End If
        End With
    End Sub
    Apply it to your needs (change object names and SQL) and try it in a copy of your form.


  4. #4
    haggis999 is offline Advanced Beginner
    Windows 10 Office 365
    Join Date
    Nov 2012
    Location
    Southampton, UK
    Posts
    60
    Hi accesstos,
    I made my post just before midnight here in the UK and woke up this morning to find your sample code. After updating it to use my own object names and data tables, it all worked fine. I really appreciate your rapid and very useful assistance

    My only comment is that the cmdAdd and cmdRemove buttons seem to be redundant, as they only work for the first selected item (even if multiple items are selected). I'm not quite sure why you would ever need that. The cmdAddAll and cmdRemoveAll buttons work for any number of selected items (and do nothing if nothing is selected) and thus appear to cover all situations. Have I missed something here?

  5. #5
    haggis999 is offline Advanced Beginner
    Windows 10 Office 365
    Join Date
    Nov 2012
    Location
    Southampton, UK
    Posts
    60
    Quote Originally Posted by ranman256 View Post
    dont use multiselect, it requires vb code.
    instead, use the list to dbl-click, which runs 1 append query to add the item to the tPickedList table.
    simple.
    Hi ranman256,
    Your double-click per selection method might lead to less VBA coding but it takes increasingly more clicks than my method as the number of selections increases. My method requires one click per selection plus one click on the move button.

    No of
    selections
    No of clicks with
    your method
    No of clicks with
    my method
    1 2 2
    2 4 3
    3 6 4
    4 8 5

    That said, if all you want is to make a single selection, your method will be quicker as you don't need to move the mouse between clicks. I will therefore look at adding the double-click method to my form.

  6. #6
    ranman256's Avatar
    ranman256 is online now VIP
    Windows Vista Access 2010 32bit
    Join Date
    Apr 2014
    Location
    Kentucky
    Posts
    9,521
    wouldnt want to strain the user.

  7. #7
    haggis999 is offline Advanced Beginner
    Windows 10 Office 365
    Join Date
    Nov 2012
    Location
    Southampton, UK
    Posts
    60
    Quote Originally Posted by ranman256 View Post
    wouldnt want to strain the user.
    I believe there is a world shortage of mouse clicks, so every little helps

  8. #8
    accesstos's Avatar
    accesstos is offline Expert
    Windows XP Access 2007
    Join Date
    Dec 2018
    Location
    Greece
    Posts
    551
    Quote Originally Posted by haggis999 View Post
    Hi accesstos,
    I made my post just before midnight here in the UK and woke up this morning to find your sample code. After updating it to use my own object names and data tables, it all worked fine. I really appreciate your rapid and very useful assistance

    My only comment is that the cmdAdd and cmdRemove buttons seem to be redundant, as they only work for the first selected item (even if multiple items are selected). I'm not quite sure why you would ever need that. The cmdAddAll and cmdRemoveAll buttons work for any number of selected items (and do nothing if nothing is selected) and thus appear to cover all situations. Have I missed something here?
    Ηι haggis999!

    No, you haven’t missed something. You are absolutely right!
    As I said, I created it recently as part of a project for personal use but I didn’t use it enough and the project is still under construction. I started with a single select Listbox and the cmdAdd/cmdRemove procedures remained from that step.
    So, your insightful comment gave me the reason to check it again and, in actually, to rewrite the code almost from scratch. As you see, we build it together and, you help me more than I help you.

    So, this is the revised (and edited) code:
    Code:
    Option Compare Database
    Option Explicit
    '
    Private Sub cmdAddAll_Click()
        'Add all available items
        MoveAll Me!lstAvail, Me!lstAdded
        Me!lstAdded.SetFocus
    End Sub
    
    Private Sub cmdRemoveAll_Click()
        'Remove all added items
        MoveAll Me!lstAdded, Me!lstAvail
        Me!lstAvail.SetFocus
    End Sub
    
    Private Sub MoveAll(lstFrom As ListBox, lstTo As ListBox)
        'Move all items (Add/Remove) between lstFrom and lstTo listboxes
        If IsNull(Me!ID) Then
            MsgBox "No current record!", vbCritical, Me.Caption
        Else
            With lstFrom
                If .ListCount > 0 Then
                    If .Left < lstTo.Left Then 'This is the "left" Listbox
                        'Add all available items
                        CurrentDb.Execute "INSERT INTO tblSiteAccounts (siteID_FK, accID_FK) " _
                                          & "SELECT siteID, " & Me!ID & " AS ID FROM (" _
                                          & .RowSource & ")", dbFailOnError
                    Else
                        'Remove all added items
                        CurrentDb.Execute "DELETE * FROM tblSiteAccounts " _
                                          & "WHERE accID_FK=" & Me!ID, dbFailOnError
                    End If
                    lstTo.Requery
                    .Requery
                End If
            End With
        End If
    End Sub
    
    Private Sub cmdAddSelected_Click()
        'Add all selected items
        MoveSelected Me!lstAvail, Me!lstAdded
    End Sub
    
    Private Sub cmdRemoveSelected_Click()
        'Remove selected added items
        MoveSelected Me!lstAdded, Me!lstAvail
    End Sub
    
    Private Sub MoveSelected(lstFrom As ListBox, lstTo As ListBox)
        'Move (Add/Remove) selected items between lstFrom and lstTo listboxes
        Dim i As Variant
        Dim j As Long
    
        If IsNull(Me!ID) Then
            MsgBox "No current record!", vbCritical, Me.Caption
        Else
            With lstFrom
                If .ItemsSelected.Count = 0 Then
                    If .ListCount = 1 Then
                        'Add the last in list. No need to select it.
                        .Selected(0) = True
                    End If
                End If
                If .ItemsSelected.Count = 0 Then
                    Beep
                Else
                    On Error Resume Next
                    j = -1
                    If .Left < lstTo.Left Then 'This is the "left" Listbox
                        'Add selected
                        For Each i In .ItemsSelected
                            CurrentDb.Execute "INSERT INTO tblSiteAccounts (siteID_FK, accID_FK) " _
                                              & "VALUES(" & .ItemData(i) & ", " & Me!ID & ")", dbFailOnError
                            j = i    'Keep the last selected item
                        Next i
                    Else
                        'Remove selected
                        For Each i In .ItemsSelected
                            CurrentDb.Execute "DELETE * FROM tblSiteAccounts " _
                                              & "WHERE siteID_FK=" & .ItemData(i) _
                                              & " AND accID_FK=" & Me!ID, dbFailOnError
    
                            j = i    'Keep the last selected item
                        Next i
                    End If
                    If j = -1 Then
                        'Nothing moved
                    Else
                        lstTo.Requery
                        'Reset the selected items
                        For Each i In .ItemsSelected
                            .Selected(i) = False
                        Next i
                        .Requery
                        If j < .ListCount Then
                        Else
                            'Get the last index if j >= .ListCount
                            j = .ListCount - 1
                        End If
                        'Select the next/last item (if any)
                        .Selected(j) = True
                    End If
                End If
            End With
        End If
    End Sub
    
    Private Sub lstAdded_KeyUp(KeyCode As Integer, Shift As Integer)
        'Use arrows to remove items
        If KeyCode = vbKeyLeft Then
            If Shift = 2 Then
                cmdRemoveAll_Click
            Else
                cmdRemoveSelected_Click
            End If
        End If
    End Sub
    
    Private Sub lstAvail_KeyUp(KeyCode As Integer, Shift As Integer)
        'Use arrows to add items
        If KeyCode = vbKeyRight Then
            If Shift = 2 Then
                cmdAddAll_Click
            Else
                cmdAddSelected_Click
            End If
        End If
    End Sub
    Now, the cmdAddAll/cmdRemoveAll acts to all items, not only to selected and the cmdAdd/cmdRemove command buttons have renamed to cmdAddSelected/cmdRemoveSelected. Some other issues fixed and some features added.
    Also, now you can move the selected items between Listboxes using the Left/Right arrows and with Ctrl+Left/Right can move all the list items of each Listbox. That’s reduces the Clicks to zero.

    Apply it to your needs as you did with the previous and try it. I think that now works really fine.

    Good luck with your project!

    Cheers,
    John

    P.S.
    In Greece, we say: The day is laughing with the night's works.
    (I don't know if I translate it correctly)

    P.S.2 (Edit)
    The .Top property replaced with the .Left in the "Move..." procedures.
    Seems that I have a demon in my keyboard...!
    Last edited by accesstos; 01-14-2021 at 07:42 AM. Reason: Code correction (bold)

  9. #9
    haggis999 is offline Advanced Beginner
    Windows 10 Office 365
    Join Date
    Nov 2012
    Location
    Southampton, UK
    Posts
    60
    Quote Originally Posted by accesstos View Post
    Ηι haggis999!

    No, you haven’t missed something. You are absolutely right!
    As I said, I created it recently as part of a project for personal use but I didn’t use it enough and the project is still under construction. I started with a single select Listbox and the cmdAdd/cmdRemove procedures remained from that step.
    So, your insightful comment gave me the reason to check it again and, in actually, to rewrite the code almost from scratch. As you see, we build it together and, you help me more than I help you.


    Now, the cmdAddAll/cmdRemoveAll acts to all items, not only to selected and the cmdAdd/cmdRemove command buttons have renamed to cmdAddSelected/cmdRemoveSelected. Some other issues fixed and some features added.
    Also, now you can move the selected items between Listboxes using the Left/Right arrows and with Ctrl+Left/Right can move all the list items of each Listbox. That’s reduces the Clicks to zero.

    Apply it to your needs as you did with the previous and try it. I think that now works really fine.

    Good luck with your project!

    Cheers,
    John

    P.S.
    In Greece, we say: The day is laughing with the night's works.
    (I don't know if I translate it correctly)

    P.S.2 (Edit)
    The .Top property replaced with the .Left in the "Move..." procedures.
    Seems that I have a demon in my keyboard...!
    You are being too modest. All I did was to point out a redundant process, but you showed me a whole new way of handling moves between listboxes that avoided all the problems I had found when trying to make use of the AddItem and RemoveItem methods. Those methods were very slow in operation and I was never able to get RemoveItem to work with multiple selections. In contrast, your method works perfectly with multiple selections and runs very quickly, even with long lists.

    I've not yet had the time to look closely at the new version of your code, but will do so later.

    With regard to your final comment, all keyboards are inhabited by demons (especially after midnight). It's the demons that make the mistakes, not us!

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 14
    Last Post: 09-03-2020, 06:26 AM
  2. Replies: 4
    Last Post: 07-02-2018, 10:38 PM
  3. Replies: 35
    Last Post: 03-19-2018, 12:06 AM
  4. Multiselect Multiple Listboxes
    By Deepak.Doddagoudar in forum Forms
    Replies: 29
    Last Post: 03-15-2018, 03:26 PM
  5. Replies: 5
    Last Post: 02-05-2013, 01:18 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums