Solved Move selected to top of listbox

[oxicottin]

I have a multi select listbox which is a long list, so I wanted to move the selected items to the lists top, so I won't have to scroll through the list upon reopening the form.

 

[MarkK]

If you want to persist, between openings and closings of the form, the selected state of individual rows in a ListBox, you will need to persist the selected state of each row somewhere, somehow. Do you have such a structure in place?

 

[Minty]

The other option would be to store the selected items in a separate table and reload them on form opening.
I would use two listboxes, one you select from (the current list) and second one with the selected items in it, and have command buttons to move from one list to the other and vice versa. Something like

 

[MajP]

I assume you are storing the selected values in a table somewhere. If that is the case then your listbox query should be ordered by Selected then by other fields. In the afterupdate you would requery bringing selected values to the top.

 

[oxicottin]

I am using a multi listbox that is unbound and saves the selections id's as a comma-delimited string in my table. @Pat Hartman I dont want to use a bunch of code like you said. I still want to save the selections as a comma-delimited string in my table though. Can you show me an example please?

Attached is what I have as of now towards the multiselect listbox

Thanks,

 

[MajP]

Not sure if I would do it this way, but this does what you are asking.

I have a table with selection IDs saved. 1,3,5...

I think you could do this without code because you should be able to get a query to sort the selected ones to the top, but without seeing your database here is a generic code to do that.
The listbox needs to be set as value list

On the forms current event
1. get the list of selections
2. get a query that pulls the selected values and write to the listbox
3. get a query of the not selected and write to the listbox
4. highlight the N selected ones

Public Sub CreateList()
  Dim strSql As String
  Dim rs As DAO.Recordset
  Dim I As Integer
  Dim NumberSelected
  
  ClearSelections
  If Not Me.Selections & "" = "" Then
    strSql = "SELECT tblSelections.SelectionID, tblSelections.Selection FROM tblSelections where SelectionID IN (" & Me.Selections & ") order by Selection"
    'Debug.Print strSql
    Set rs = CurrentDb.OpenRecordset(strSql)
    
    'do the selected ones first
    Do While Not rs.EOF
      Me.lstSelections.AddItem rs!selectionID & "; " & rs!Selection
      NumberSelected = I
      I = I + 1
      rs.MoveNext
    Loop
    'select
     strSql = "SELECT tblSelections.SelectionID, tblSelections.Selection FROM tblSelections where SelectionID NOT IN (" & Me.Selections & ") order by Selection"
    
    Set rs = CurrentDb.OpenRecordset(strSql)
     Do While Not rs.EOF
      Me.lstSelections.AddItem rs!selectionID & "; " & rs!Selection
      I = I + 1
      rs.MoveNext
    Loop
  Else
    'add all items if none selected
    NumberSelected = -1
    strSql = "SELECT tblSelections.SelectionID, tblSelections.Selection FROM tblSelections order by Selection"
     Set rs = CurrentDb.OpenRecordset(strSql)
    Do While Not rs.EOF
      Me.lstSelections.AddItem rs!selectionID & "; " & rs!Selection
      I = I + 1
      rs.MoveNext
    Loop
  
  End If
 
  For I = 0 To NumberSelected
      Me.lstSelections.Selected(I) = True
  Next I

End Sub
Public Sub ClearSelections()
  Dim I As Integer
  For I = Me.lstSelections.ListCount - 1 To 0 Step -1
     
    lstSelections.RemoveItem (I)
  Next I
End Sub
Private Sub lstSelections_AfterUpdate()
  Dim I As Integer
  Dim idx As Variant
  Me.Selections = Null
  For I = 0 To Me.lstSelections.ItemsSelected.Count - 1
    idx = Me.lstSelections.ItemsSelected(I)
    If Me.Selections & "" = "" Then
      Me.Selections = Me.lstSelections.ItemData(idx)
    Else
      Me.Selections = Me.Selections & "," & Me.lstSelections.ItemData(idx)
    End If
  Next I
  Me.Selections.SetFocus
  Me.Selections.Value = Me.Selections.Text
  CreateList
End Sub

 

[arnelgp]

I have a multi select listbox which is a long list, so I wanted to move the selected items to the lists top, so I won't have to scroll through the list upon reopening the form.

..so you only want it to be ordered (ordered by selected first, then the rest) when the form opens.
you can change recordsource on the current event of your form.

Private Sub Form_Current()
'Uses module mod_MultiListbox

    Call ClearListbox(Me.lstDefects)  'Clear the listbox
    
    If Not IsNull(Me.SelectedIDs) Then
        
        '/ arnelgp
        ' change recordsource
        ' so that the selected are first on the list
        '
        Dim sql As String
        sql = "SELECT tbl_ProductDefects.DefectID, tbl_ProductDefects.Defect, 1 As Priority " & _
                "FROM tbl_ProductDefects " & _
                "WHERE DefectID IN (" & Me.SelectedIDs & ") " & _
                "UNION " & _
                "SELECT tbl_ProductDefects.DefectID, tbl_ProductDefects.Defect, 2 As Priority " & _
                "FROM tbl_ProductDefects " & _
                "WHERE DefectID NOT IN (" & Me.SelectedIDs & ") " & _
                "ORDER BY 3, 1;"
                
        Me.lstDefects.RowSource = sql
        '
        '/ end of code
        
        Call SelectLBX(Me.lstDefects, Me.SelectedIDs)  'Gathers data for listbox
        DoListboxStuff  'Call function
        
    End If
    
End Sub

 

[Eugene-LS]

so I wanted to move the selected items to the lists top

Private Function GetListValues() As Variant
Dim sVal$, idx%
    For idx = 0 To Me.lstDefects.ListCount - 1
        If Me.lstDefects.Selected(idx) = True Then
            sVal = sVal & csDelimeter & Me.lstDefects.ItemData(idx)
        End If
    Next idx
    
    If Len(sVal) > Len(csDelimeter) Then
        GetListValues = Mid(sVal, Len(csDelimeter) + 1)
    End If
End Function

Private Sub SetItemsSelected(vArr As Variant)
Dim idx%, iVal%
' set selections from array
    For iVal = 0 To UBound(vArr)
        For idx = 0 To Me.lstDefects.ListCount - 1
            If Me.lstDefects.ItemData(idx) = vArr(iVal) Then
                Me.lstDefects.Selected(idx) = True
             End If
        Next idx
    Next iVal
End Sub

Private Sub DoListboxStuff(Optional blnNoMsg As Boolean)
Dim sSQL$, sVal$, idx%, iVal%, vArr As Variant

    
    If Me.lstDefects.ItemsSelected.Count = 0 Then
        Me.lstDefects.RowSource = csDefaultRowSource
        If blnNoMsg = False Then _
            MsgBox "There are no selected items!", vbExclamation
        Exit Sub
    End If
    
    For idx = 0 To Me.lstDefects.ListCount - 1
        If Me.lstDefects.Selected(idx) = True Then
            sVal = sVal & csDelimeter & Me.lstDefects.ItemData(idx)
        End If
    Next idx
    
    sVal = GetListValues & ""
    vArr = Split(sVal, csDelimeter) ' save selection in array

' new RowSource for lstDefects:
    sSQL = "SELECT DefectID, Defect FROM" & vbCrLf & _
        "   (SELECT * FROM tbl_ProductDefects ORDER BY Defect) as Q01" & vbCrLf & _
        "   WHERE DefectID IN (" & sVal & ")" & vbCrLf & _
        "UNION ALL" & vbCrLf & _
        "SELECT DefectID, Defect FROM" & vbCrLf & _
        "   (SELECT * FROM tbl_ProductDefects ORDER BY Defect) as Q01" & vbCrLf & _
        "   WHERE DefectID NOT IN (" & sVal & ")"
    'Debug.Print sSQL
    Me.lstDefects.RowSource = sSQL
    
    SetItemsSelected vArr
End Sub

Private Sub Form_Current()
Dim vArr As Variant
    If Not IsNull(Me.SelectedIDs) Then
        vArr = Split(Me.SelectedIDs, csDelimeter)
        SetItemsSelected vArr
        DoListboxStuff True 'Call function
    End If
End Sub

 

[oxicottin]

Thanks everyone for the examples, ill play with them when I get back to work after the weekend