Moving records between listboxes. (1 Viewer)

lumiere

New member
Local time
Today, 15:44
Joined
Nov 10, 2019
Messages
29
Hello all. I am having some problems in moving data from one list box to another.

I have attached the database below.

Form 1 contains two listboxes, labelled Left and Right. My objective is to select multiple records from left listbox and move them to the right listbox. I can successfully transfer single records but when I select multiple records and press the button (">") to move them, all the selected records get copied but only the last selected record in the left listbox gets deleted.

The code I used is as below. lstDataLS and lstDataRS are left and right listboxes respectively. The code runs after pressing a button.

Code:
Dim Msg As String
    Dim i, j As Variant
    Dim a As Long
    
    If Me.lstDataLS.ListIndex = -1 Then
        Msg = "Nothing"
    Else
        For Each i In Me.lstDataLS.ItemsSelected
            Msg = "" & Me.lstDataLS.Column(0, i)
            Me.lstDataRS.AddItem (Msg)
        Next i
        
    End If
    Do While lstDataLS.ListIndex <> -1
        Me.lstDataLS.RemoveItem (Me.lstDataLS.ListIndex)
    Loop

Can anyone help me to find out what am I doing incorrectly.
Thanks.
 

Attachments

  • T2 - Copy.accdb
    1 MB · Views: 362

Gasman

Enthusiastic Amateur
Local time
Today, 22:44
Joined
Sep 21, 2011
Messages
14,048
I would just repeat your loop for remove items, but perhaps do it in reverse.?
 

CJ_London

Super Moderator
Staff member
Local time
Today, 22:44
Joined
Feb 19, 2013
Messages
16,553
you have two problems - the first as Gasman says, you need to remove in reverse order and the second is that when you remove your first item, the selected collection is destroyed. So you need to create your selected list, in reverse first, or at least before starting to delete

Code:
    Dim i As Integer
    Dim selected As Collection
    Dim itm As Variant
  
    Set selected = New Collection
  
    'get list of selected items in reverse order
    For i = lstDataLS.ListCount - 1 To 0 Step -1
        If lstDataLS.selected(i) Then
            selected.Add i
        End If
    Next
  
    'update lstDataRS
    For i = 0 To lstDataLS.ListCount - 1
        If lstDataLS.selected(i) Then
            lstDataRS.AddItem lstDataLS.ItemData(i)
        End If
    Next
      
    'update lstDataLS
    For Each itm In selected
        lstDataLS.RemoveItem itm
    Next itm
 

MarkK

bit cruncher
Local time
Today, 15:44
Joined
Mar 17, 2004
Messages
8,178
Exactly as CJ says. In addition, if you break it out into a subroutine you can use the same code to move stuff in both directions...
Code:
Private Sub cmdMoveRight_Click()
    MoveSelected Me.lstLeft, Me.lstRight
End Sub

Private Sub cmdMoveLeft_Click()
    MoveSelected Me.lstRight, Me.lstLeft
End Sub

Private Sub MoveSelected(src As Access.ListBox, dst As Access.ListBox)
    Dim c As New VBA.Collection
    Dim vi
    
    ' create reverse order collection of selected indices
    For vi = src.ItemsSelected.Count - 1 To 0 Step -1
        c.Add src.ItemsSelected(vi)
    Next
    
    ' traverse collection, moving each item
    For Each vi In c
        dst.AddItem src.Column(0, vi)
        src.RemoveItem vi
    Next
    
End Sub
 

CJ_London

Super Moderator
Staff member
Local time
Today, 22:44
Joined
Feb 19, 2013
Messages
16,553
@MarkK - agree you can make it a standard function - only potential problem with your code is if

a
b
c

is selected

the destination will result with

c
b
a

which may or may not matter to the OP
 

lumiere

New member
Local time
Today, 15:44
Joined
Nov 10, 2019
Messages
29
The codes worked perfectly. Thank you.

However, I planned to sort the contents of Right listbox by press of a button.

I copied the contents of Right listbox in an array, deleted the contents of right listbox and copied back the array into this listbox, but I am getting empty list box.

Code:
Dim ListArray() As String
Dim i As Integer
Dim j, k As Integer
ReDim ListArray(Me.lstDataRS.ListCount - 1)

For i = 0 To Me.lstDataRS.ListCount - 1
    ListArray(i) = Me.lstDataRS.Column(0, i)
Next i

Call Array_BubbleSort(ListArray)

For k = Me.lstDataRS.ListCount - 1 To 0 Step -1
Me.lstDataRS.RemoveItem (k)
Next k

For j = 0 To Me.lstDataRS.ListCount - 1
Me.lstDataRS.AddItem ListArray(j)
Next j

The codes for bubble sort were

Code:
Public Sub Array_BubbleSort(ByRef vArrayName As Variant, _
                   Optional ByVal lUpper As Long = -1, _
                   Optional ByVal lLower As Long = -1)

Dim vArrayResult1 As Variant
Dim vArrayResult2 As Variant
Dim vArrayResult3 As Variant
Dim vtemp As Variant
Dim i As Long
Dim j As Long
Dim bAllSwapped As Boolean
Dim inoofswaps As Integer
Dim inoofloops As Integer

   If IsEmpty(vArrayName) = True Then Exit Sub
   If lLower = -1 Then lLower = LBound(vArrayName, 1)
   If lUpper = -1 Then lUpper = UBound(vArrayName, 1)

vArrayResult3 = vArrayName
   inoofswaps = 0
   inoofloops = 0
   Do
      bAllSwapped = False
      For j = lLower To (lUpper - 1)
         If (vArrayResult3(j) > vArrayResult3(j + 1)) Then
            vtemp = vArrayResult3(j)
            vArrayResult3(j) = vArrayResult3(j + 1)
            vArrayResult3(j + 1) = vtemp
            bAllSwapped = True
            inoofswaps = inoofswaps + 1
         End If
         inoofloops = inoofloops + 1
      Next j
      lUpper = lUpper - 1
   Loop Until bAllSwapped = False
   Debug.Print "Algorithm 3 - swaps:" & inoofswaps & " loops:" & inoofloops
vArrayName = vArrayResult3

Am I missing something in the button code? Please help.
 

MarkK

bit cruncher
Local time
Today, 15:44
Joined
Mar 17, 2004
Messages
8,178
Here's the same functionality using disconnected ADODB.Recordsets, which are easy to bind, easy to sort, and end up needing less code.
 

Attachments

  • DisconnectedRecordsets.accdb
    580 KB · Views: 389

MarkK

bit cruncher
Local time
Today, 15:44
Joined
Mar 17, 2004
Messages
8,178
Here's a way simpler way to sort an array in VBA, but you have to have the .NET framework 3.5 installed on your machine.
Code:
Function SortArray(vArray)
    Dim al As Object: Set al = CreateObject("System.Collections.ArrayList")
    Dim vi
    
    For Each vi In vArray
        al.Add vi
    Next
    
    al.sort
    
    SortArray = al.ToArray
    
End Function

Sub TestSortArray()
    Const LIST As String = "The quick brown fox jumps over the lazy dog"
    Dim vi
    
    For Each vi In SortArray(Split(LIST))
        Debug.Print vi
    Next
End Sub
 

MarkK

bit cruncher
Local time
Today, 15:44
Joined
Mar 17, 2004
Messages
8,178
You can also sort an array using a disconnected ADO recordset...
Code:
Function SortArrayRS(vArray)
    Dim vi
    
    With New ADODB.Recordset
        ' create single field disconnected recordset
        .CursorLocation = adUseClient
        .Fields.Append "s", adVarWChar, 255, adFldIsNullable
        .Open
        
        ' add array elements
        For Each vi In vArray
            .AddNew
            .Fields(0) = vi
            .Update
        Next
        
        .sort = "s"
        
        ' return sorted elements to the array
        .MoveFirst
        Do While Not .EOF
            vArray(CLng(.AbsolutePosition) - 1) = .Fields(0).Value
            .MoveNext
        Loop
    End With
    
    SortArrayRS = vArray
End Function
That code requires a reference to ADODB.
 

moke123

AWF VIP
Local time
Today, 18:44
Joined
Jan 11, 2013
Messages
3,852
Here's the same functionality using disconnected ADODB.Recordsets, which are easy to bind, easy to sort, and end up needing less code.
Very nice. Wish I knew Adodb. From what I can tell they're very similiar with a few suttle differences.
 

MarkK

bit cruncher
Local time
Today, 15:44
Joined
Mar 17, 2004
Messages
8,178
Hey Moke,
I don't know much ADODB either, but disconnecting a recordset like that can be super handy, and it's impossible in DAO.
Cheers,
Mark
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 06:44
Joined
May 7, 2009
Messages
19,169
for you Sorting code (post #6):
Code:
Public Function Bubble_Sort(arrVariant As Variant) As Variant
    Dim lLoop1 As Long
    Dim lLoop2 As Long
    Dim lTemp As Variant
    For lLoop1 = UBound(arrVariant) To LBound(arrVariant) Step -1
      For lLoop2 = LBound(arrVariant) + 1 To lLoop1
        If arrVariant(lLoop2 - 1) > arrVariant(lLoop2) Then
          lTemp = arrVariant(lLoop2 - 1)
          arrVariant(lLoop2 - 1) = arrVariant(lLoop2)
          arrVariant(lLoop2) = lTemp
        End If
      Next lLoop2
    Next lLoop1
    Bubble_Sort = arrVariant
End Function

the code on your Sort Button:
Code:
Private Sub cmdSort_Click()
Dim lst As Variant
lst = Split(Replace$(Me.lstDataRS.RowSource, """", ""), ";")
Call Bubble_Sort(lst)
Me.lstDataRS.RowSource = """" & Join(lst, """;""") & """"
End Sub
 

lumiere

New member
Local time
Today, 15:44
Joined
Nov 10, 2019
Messages
29
for you Sorting code (post #6):
Code:
Public Function Bubble_Sort(arrVariant As Variant) As Variant
    Dim lLoop1 As Long
    Dim lLoop2 As Long
    Dim lTemp As Variant
    For lLoop1 = UBound(arrVariant) To LBound(arrVariant) Step -1
      For lLoop2 = LBound(arrVariant) + 1 To lLoop1
        If arrVariant(lLoop2 - 1) > arrVariant(lLoop2) Then
          lTemp = arrVariant(lLoop2 - 1)
          arrVariant(lLoop2 - 1) = arrVariant(lLoop2)
          arrVariant(lLoop2) = lTemp
        End If
      Next lLoop2
    Next lLoop1
    Bubble_Sort = arrVariant
End Function

the code on your Sort Button:
Code:
Private Sub cmdSort_Click()
Dim lst As Variant
lst = Split(Replace$(Me.lstDataRS.RowSource, """", ""), ";")
Call Bubble_Sort(lst)
Me.lstDataRS.RowSource = """" & Join(lst, """;""") & """"
End Sub
Thanks a lot for help. The code works great.
I was wondering if my list box had multiple columns, and sorting was be done based on any one column, could this method be applicable?
 

lumiere

New member
Local time
Today, 15:44
Joined
Nov 10, 2019
Messages
29
You can also sort an array using a disconnected ADO recordset...
Code:
Function SortArrayRS(vArray)
    Dim vi
   
    With New ADODB.Recordset
        ' create single field disconnected recordset
        .CursorLocation = adUseClient
        .Fields.Append "s", adVarWChar, 255, adFldIsNullable
        .Open
       
        ' add array elements
        For Each vi In vArray
            .AddNew
            .Fields(0) = vi
            .Update
        Next
       
        .sort = "s"
       
        ' return sorted elements to the array
        .MoveFirst
        Do While Not .EOF
            vArray(CLng(.AbsolutePosition) - 1) = .Fields(0).Value
            .MoveNext
        Loop
    End With
   
    SortArrayRS = vArray
End Function
That code requires a reference to ADODB.
Thanks for the code.
I tried this, but it shows type mismatch error(Run-time error 13), and (For Each vi In vArray) line is highlighted during debugging. Can you please help me rectify it? I am new to ADODB.
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 06:44
Joined
May 7, 2009
Messages
19,169
here is a sample sorting on multi column listbox.
 

Attachments

  • single column listbox sort.accdb
    704 KB · Views: 373

gemma-the-husky

Super Moderator
Staff member
Local time
Today, 22:44
Joined
Sep 12, 2006
Messages
15,614
Are the two list boxes based on different tables, or the same tabl?

One way is to use a single table with a "tagged" property/field. Show the untagged items on the left, and the tagged items on the right.
Then just tag/untag the items you want to move (either way), and use the arrow buttons to requery the list boxes, so you never have to synchronise moving items.
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 06:44
Joined
May 7, 2009
Messages
19,169
another modification. you can sort on 1 up to the number of columns you have either in ASCending or DESCending order.
 

Attachments

  • single column listbox sort.accdb
    480 KB · Views: 386

MarkK

bit cruncher
Local time
Today, 15:44
Joined
Mar 17, 2004
Messages
8,178
I tried this, but it shows type mismatch error(Run-time error 13)
I don't recommend using a disconnected recordset to sort an array. I posted it more for interest's sake, to see if it could be done. If you really need to sort an array, use @arnelgp's BubbleSort, or use this ...
Code:
Function SortArray(vArray)
    Dim al As Object: Set al = CreateObject("System.Collections.ArrayList")
    Dim vi
    
    For Each vi In vArray
        al.Add vi
    Next
    al.sort
    SortArray = al.ToArray
End Function
If you want to sort data in a ListBox, then disconnected recordsets make sense, and I direct your attention back to post #8, which does a tidy job of it.
 

Users who are viewing this thread

Top Bottom