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
..so you only want it to be ordered (ordered by selected first, then the rest) when the form opens.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.
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
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
The NO code solution is a many-side table and a subform. This also normalizes your schema and makes other things easier and also no or little code.I am using a multi listbox that is unbound and saves the selections id's as a comma-delimited string in my table.