Display multiple fields when moving items up/down within a listbox 2

[MrMode]

I have a listbox where selected items that include 3 fields (
ClassRank, ClassNumber, ClassDescription) are added in order for me to re-order them:

  Dim varItem As Variant
  Dim strAdd As String
  Dim columnCount As Integer
  Dim i As Integer

  
  columnCount = List12.columnCount
  For Each varItem In List12.ItemsSelected
     For i = 0 To columnCount - 1
        If strAdd = "" Then
           strAdd = List12.Column(i, varItem)
        Else
           strAdd = strAdd & ";" & List12.Column(i, varItem)
        End If
     Next i
      List14.RowSourceType = "value list"
      List14.AddItem strAdd
      strAdd = ""
  Next varItem

I have being able to get code working to move items up and down within the listbox.

Dim sText As String
Dim iIndex As Variant
Dim selection() As Integer
Dim n, topSelection As Integer

' save the indexes of the selected items,
' they will be deselected after the first removal
For Each iIndex In List14.ItemsSelected
    ReDim Preserve selection(0 To n)
    selection(n) = iIndex
    n = n + 1
Next

'loop through all the selected indexes
'this will also ensure you will only proceed if there is a selected item
For n = LBound(selection) To UBound(selection)
    'save items text and items indexvalue
    sText = List14.Column(0, selection(n))

    If selection(n) <= topSelection Then 'index topSelection is top item which can't be moved up!
        MsgBox ("Can not move item '" & sText & "' up any higher.")
        topSelection = topSelection + 1
    Else
        'first remove item from old position
        List14.RemoveItem selection(n)
        'place item back on new position
        List14.AddItem sText, selection(n) - 1
        'change the index of the selected value to the new index (for reselection)
        selection(n) = selection(n) - 1
    End If
Next
'loop through the selection again to reselect
For n = LBound(selection) To UBound(selection)
    List14.Selected(selection(n)) = True
Next

However, when the item is moved only the first of the 3 fields are visible. How do I get all three fields to be displayed in the new position?

 

[PHV]

Replace this:
sText = List14.Column(0, selection)
with this:
sText = List14.Column(0, selection) & ";" & List14.Column(1, selection) & ";" & List14.Column(2, selection)

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[MrMode]

Awesome, thank you very much - works perfectly

 

[MrMode]

Hmm, it was all going so well...

Moving items up the list 1 or more than one, works.

'Move item up the list

Dim sText As String
Dim iIndex As Variant
Dim selection() As Integer
Dim n, topSelection As Integer

' save the indexes of the selected items, they will be deselected after the first removal
For Each iIndex In List6.ItemsSelected
    ReDim Preserve selection(0 To n)
    selection(n) = iIndex
    n = n + 1
Next

'loop through all the selected indexes this will also ensure you will only proceed if there is a selected item
For n = LBound(selection) To UBound(selection)
    'save items text and items indexvalue
    sText = List6.Column(0, selection(n)) & ";" & List6.Column(1, selection(n)) & ";" & List6.Column(2, selection(n)) & ";" & List6.Column(3, selection(n)) & ";" & List6.Column(4, selection(n)) & ";" & List6.Column(5, selection(n)) & ";" & List6.Column(6, selection(n))


    If selection(n) <= topSelection Then 'index topSelection is top item which can't be moved up!
        MsgBox ("Can not move item up any higher."), , "Oops"
        topSelection = topSelection + 1
    Else
        'first remove item from old position
        List6.RemoveItem selection(n)
        'place item back on new position
        List6.AddItem sText, selection(n) - 1
        'change the index of the selected value to the new index (for reselection)
        selection(n) = selection(n) - 1
    End If
Next
'loop through the selection again to reselect
For n = LBound(selection) To UBound(selection)
    List6.Selected(selection(n)) = True
Next

Moving more than one items down the list does not.If I select more than 1 item (let's say 3) and use the command button to move them down the list, one of the records moves three spaces but the other two I selected stay where they were?!

'Move item down the list

Dim sText As String
Dim iIndex As Variant
Dim selection() As Integer
Dim n, topSelection As Integer
Dim endingNumber As Integer

endingNumber = Me.List6.ListCount - 1

' save the indexes of the selected items, they will be deselected after the first removal
For Each iIndex In List6.ItemsSelected
    ReDim Preserve selection(0 To n)
    selection(n) = iIndex
    n = n + 1
Next

'loop through all the selected indexes this will also ensure you will only proceed if there is a selected item
For n = LBound(selection) To UBound(selection)
    'save items text and items indexvalue
    sText = List6.Column(0, selection(n)) & ";" & List6.Column(1, selection(n)) & ";" & List6.Column(2, selection(n)) & ";" & List6.Column(3, selection(n)) & ";" & List6.Column(4, selection(n)) & ";" & List6.Column(5, selection(n)) & ";" & List6.Column(6, selection(n))


    If selection(n) >= endingNumber Then
     MsgBox "You cannot move the bottom selection on the list further down.", , "Oops"
     Exit Sub
    Else
        'first remove item from old position
        List6.RemoveItem selection(n)
        'place item back on new position
        List6.AddItem sText, selection(n) + 1
        'change the index of the selected value to the new index (for reselection)
        selection(n) = selection(n) + 1
    End If
Next
'loop through the selection again to reselect
For n = LBound(selection) To UBound(selection)
    List6.Selected(selection(n)) = True
Next

 

[MrMode]

If I capture iIndex value, it is showing the current indexes for the selected rows in both Move Up and Move down procedures.

If I capture the sText values, in the Move up procedure the different records print out, in the move down procedure only one of the records is output then repeated for the number of items selected (e.g. if I picked 3 records, then one row's value is printed 3 times)

The issue seems to be in here, but I cannot figure it out?!

'loop through all the selected indexes this will also ensure you will only proceed if there is a selected item
For n = LBound(selection) To UBound(selection)
    'save items text and items indexvalue
    sText = List6.Column(0, selection(n)) & ";" & List6.Column(1, selection(n)) & ";" & List6.Column(2, selection(n)) & ";" & List6.Column(3, selection(n)) & ";" & List6.Column(4, selection(n)) & ";" & List6.Column(5, selection(n)) & ";" & List6.Column(6, selection(n))

 

[MajP]

In your for loop need to go ubound to lbound step -1

 

[MrMode]

Wow! Works perfectly, thank you.