ListBox Utilities
|
THIS PAGE HAS BEEN REPLACED. Click here to go to the new page if you are not automatically redirected. This page describe a number of utility functions designed to make the MSForms ListBox control easier to use. You can download a bas module file or a complete sample workbook. The functions require the modQSortInPlace code module, which is included in the zip files and described on the Sorting Arrays With QSort page. The functions and their code are shown below.
LBXInvertSelection Public Sub LBXInvertSelection(LBX As MSForms.ListBox)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LBXInvertSelection
' Inverts selected items. Selected items are unselected and selected
' items are unselected.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Ndx As Long
With LBX
''''''''''''''''''''''''
' If list is empty, get
' out now.
''''''''''''''''''''''''
If .ListCount = 0 Then
Exit Sub
End If
For Ndx = 0 To .ListCount - 1
.Selected(Ndx) = Not .Selected(Ndx)
Next Ndx
End With
End Sub
LBXIsListSorted Public Function LBXIsListSorted(LBX As MSForms.ListBox, _
Optional Descending As Boolean = False, _
Optional CompareMode As VbCompareMethod = vbTextCompare) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LBXIsListSorted
' This function returns True if the List is sorted in either
' ascending order or descending order, depending on the value of
' the Descending parameter. If the list is not sorted, it returns
' False. If the List is empty, the result is True. Adjacent
' duplicate items are allowed an by themselves do not indicate that
' the List is not sorted.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Ndx As Long
With LBX
''''''''''''''''''''''''''''
' See if the list is empty.
''''''''''''''''''''''''''''
If .ListCount = 0 Then
LBXIsListSorted = True
Exit Function
End If
For Ndx = 0 To .ListCount - 2
'''''''''''''''''''''''''''''''''''''''''''''
' Loop through all but the last two entries.
' The code will compare List(Ndx) with
' List(Ndx+1) to determine whether the List
' is sorted.
'''''''''''''''''''''''''''''''''''''''''''''
If Descending = False Then
If Ndx < .ListCount - 2 Then
'''''''''''''''''''''''''''''''''''''''''''
' Test to see if .List(Ndx) is greater than
' .List(Ndx+1). If .List(Ndx) is greater
' than List(Ndx+1), the these two elements
' are not in ascending sorted order, so
' return False and get out.
''''''''''''''''''''''''''''''''''''''''''''
If StrComp(.List(Ndx), .List(Ndx + 1), CompareMode) > 0 Then
LBXIsListSorted = False
Exit Function
End If
End If
Else
If Ndx < .ListCount - 2 Then
'''''''''''''''''''''''''''''''''''''''''
' Test to see if List(Ndx) is less than
' List(Ndx+1). If List(Ndx) is less than
' List(Ndx+1), then these two elements
' are not in descending sorted order, so
' returns False and get out.
'''''''''''''''''''''''''''''''''''''''''
If StrComp(.List(Ndx), .List(Ndx + 1), CompareMode) < 0 Then
LBXIsListSorted = False
Exit Function
End If
End If
End If
Next Ndx
'''''''''''''''''''''''''''''''''
' If we make it out of the loop,
' all items are in sorted order,
' so return True.
'''''''''''''''''''''''''''''''''
LBXIsListSorted = True
End With
End Function
LBXIsSelectionContiguous Public Function LBXIsSelectionContiguous(LBX As MSForms.ListBox) As Boolean
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LBXIsSelectionContiguous
' This returns True if all selected items are contiguous, or False if
' they are not.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim SelCount As Long
Dim FirstItem As Long
Dim LastItem As Long
Dim Ndx As Long
''''''''''''''''''''''''
' If list is empty, get
' out now.
''''''''''''''''''''''''
If LBX.ListCount = 0 Then
Exit Function
End If
LBXSelectionInfo LBX:=LBX, SelectedCount:=SelCount, FirstSelectedItemIndex:=FirstItem, _
LastSelectedItemIndex:=LastItem
If SelCount > 0 Then
For Ndx = FirstItem To LastItem
If LBX.Selected(Ndx) = False Then
LBXIsSelectionContiguous = False
Exit Function
End If
Next Ndx
End If
LBXIsSelectionContiguous = True
End Function
LBXMoveDown Public Sub LBXMoveDown(LBX As MSForms.ListBox)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LBXMoveDown
' This move the selected items down one position in the list.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Temp As String ' temporary variable to hold value for swap
Dim Ndx As Long ' index counter for LBX.List
Dim SelNdx As Long ' index of selected items
Dim SelCount As Long ' number of selected items
Dim FirstSelItem As Long ' first selected item index
Dim LastSelItem As Long ' last selected item index
Dim SaveNdx As Long ' saved index to reselect items
''''''''''''''''''''''''
' If list is empty, get
' out now.
''''''''''''''''''''''''
If LBX.ListCount = 0 Then
Exit Sub
End If
''''''''''''''''''''''''''''''''''''
' Ensure the selected items
' are contiguous (no unselected rows
' within selected rows).
''''''''''''''''''''''''''''''''''''
If LBXIsSelectionContiguous(LBX:=LBX) = False Then
Exit Sub
End If
With LBX
If .ColumnCount > 1 Then
''''''''''''''''''''''''''
' No support for mutliple
' column listboxes.
''''''''''''''''''''''''''
Exit Sub
End If
''''''''''''''''''''''''''''''
' If the list is empty, there
' is nothing to do. Get out.
''''''''''''''''''''''''''''''
If .ListCount = 0 Then
Exit Sub
End If
'''''''''''''''''''''''''''''
' If there is no selected
' item, there is nothing to
' do. Get Out.
'''''''''''''''''''''''''''''
If .ListIndex < 0 Then
Exit Sub
End If
''''''''''''''''''''''''''''''''''''''''''''''''
' Get information about the selected items
' in the list box LBX.
''''''''''''''''''''''''''''''''''''''''''''''''
LBXSelectionInfo LBX:=LBX, SelectedCount:=SelCount, _
FirstSelectedItemIndex:=FirstSelItem, LastSelectedItemIndex:=LastSelItem
''''''''''''''''''''''''''''''''''
' If nothing is selected, get out.
''''''''''''''''''''''''''''''''''
If SelCount = 0 Then
Exit Sub
End If
''''''''''''''''''''''''''''''''''''
' If no items are selected, get out.
' This should be picked up in
' SelCount = 0, but we test here for
' completeness.
''''''''''''''''''''''''''''''''''''
If (FirstSelItem < 0) Or (LastSelItem < 0) Then
Exit Sub
End If
SelNdx = 0
Ndx = 0
For SelNdx = LastSelItem To FirstSelItem Step -1
If LastSelItem = .ListCount - 1 Then
Exit Sub
End If
If SelNdx = .ListCount - 1 Then
SaveNdx = SelNdx
Exit For
End If
If LastSelItem = .ListCount - 1 Then
Exit For
End If
Temp = .List(SelNdx)
.RemoveItem SelNdx
.AddItem Temp, SelNdx + 1
SaveNdx = SelNdx + 1
Next SelNdx
LBXUnSelectAllItems LBX:=LBX
For Ndx = SaveNdx To SaveNdx + (LastSelItem - FirstSelItem)
.Selected(Ndx) = True
Next Ndx
End With
End Sub
LBXMoveToEnd Public Sub LBXMoveToEnd(LBX As MSForms.ListBox)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LBXMoveToEnd
' This move the selected items to the end of the list.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Temp As String ' temporary variable to hold value for swap
Dim Ndx As Long ' index counter for LBX.List
Dim SelNdx As Long ' index of selected items
Dim SelCount As Long ' number of selected items
Dim FirstSelItem As Long ' first selected item index
Dim LastSelItem As Long ' last selected item index
Dim SaveNdx As Long ' saved index to reselect items at end
''''''''''''''''''''''''
' If list is empty, get
' out now.
''''''''''''''''''''''''
If LBX.ListCount = 0 Then
Exit Sub
End If
''''''''''''''''''''''''''''''''''''
' Ensure the selected items
' are contiguous (no unselected rows
' within selected rows).
''''''''''''''''''''''''''''''''''''
If LBXIsSelectionContiguous(LBX:=LBX) = False Then
Exit Sub
End If
With LBX
If .ColumnCount > 1 Then
''''''''''''''''''''''''''
' No support for mutliple
' column listboxes.
''''''''''''''''''''''''''
Exit Sub
End If
''''''''''''''''''''''''''''''
' If the list is empty, there
' is nothing to do. Get out.
''''''''''''''''''''''''''''''
If .ListCount = 0 Then
Exit Sub
End If
'''''''''''''''''''''''''''''
' If there is no selected
' item, there is nothing to
' do. Get Out.
'''''''''''''''''''''''''''''
If .ListIndex < 0 Then
Exit Sub
End If
''''''''''''''''''''''''''''''''''''''''''''''''
' Get information about the selected items
' in the list box LBX.
''''''''''''''''''''''''''''''''''''''''''''''''
LBXSelectionInfo LBX:=LBX, SelectedCount:=SelCount, _
FirstSelectedItemIndex:=FirstSelItem, LastSelectedItemIndex:=LastSelItem
''''''''''''''''''''''''''''''''''
' If nothing is selected, get out.
''''''''''''''''''''''''''''''''''
If SelCount = 0 Then
Exit Sub
End If
''''''''''''''''''''''''''''''''''''
' If no items are selected, get out.
' This should be picked up in
' SelCount = 0, but we test here for
' completeness.
''''''''''''''''''''''''''''''''''''
If (FirstSelItem < 0) Or (LastSelItem < 0) Then
Exit Sub
End If
SelNdx = 0
Ndx = 0
For SelNdx = LastSelItem To FirstSelItem Step -1
Temp = .List(SelNdx)
.RemoveItem SelNdx
.AddItem Temp, .ListCount - Ndx
SaveNdx = .ListCount - 1 - Ndx
Ndx = Ndx + 1
Next SelNdx
LBXUnSelectAllItems LBX:=LBX
For Ndx = SaveNdx To .ListCount - 1
.Selected(Ndx) = True
Next Ndx
End With
End Sub
LBXMoveToTop Public Sub LBXMoveToTop(LBX As MSForms.ListBox)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LBXMoveToTop
' This moves the selected items to the top of the list box.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Temp As String ' temporary variable to hold value for swap
Dim Ndx As Long ' index counter for LBX.List
Dim SelNdx As Long ' index of selected items
Dim SelCount As Long ' number of selected items
Dim FirstSelItem As Long ' first selected item index
Dim LastSelItem As Long ' last selected item index
''''''''''''''''''''''''
' If list is empty, get
' out now.
''''''''''''''''''''''''
If LBX.ListCount = 0 Then
Exit Sub
End If
''''''''''''''''''''''''''''''''''''
' Ensure the selected items
' are contiguous (no unselected rows
' within selected rows).
''''''''''''''''''''''''''''''''''''
If LBXIsSelectionContiguous(LBX:=LBX) = False Then
Exit Sub
End If
With LBX
If .ColumnCount > 1 Then
''''''''''''''''''''''''''
' No support for mutliple
' column listboxes.
''''''''''''''''''''''''''
Exit Sub
End If
''''''''''''''''''''''''''''''
' If the list is empty, there
' is nothing to do. Get out.
''''''''''''''''''''''''''''''
If .ListCount = 0 Then
Exit Sub
End If
'''''''''''''''''''''''''''''
' If there is no selected
' item, there is nothing to
' do. Get Out.
'''''''''''''''''''''''''''''
If .ListIndex < 0 Then
Exit Sub
End If
''''''''''''''''''''''''''''''''''''''''''''''''
' Get information about the selected items
' in the list box LBX.
''''''''''''''''''''''''''''''''''''''''''''''''
LBXSelectionInfo LBX:=LBX, SelectedCount:=SelCount, _
FirstSelectedItemIndex:=FirstSelItem, LastSelectedItemIndex:=LastSelItem
''''''''''''''''''''''''''''''''''
' If nothing is selected, get out.
''''''''''''''''''''''''''''''''''
If SelCount = 0 Then
Exit Sub
End If
''''''''''''''''''''''''''''''''''''
' If no items are selected, get out.
' This should be picked up in
' SelCount = 0, but we test here for
' completeness.
''''''''''''''''''''''''''''''''''''
If (FirstSelItem < 0) Or (LastSelItem < 0) Then
Exit Sub
End If
SelNdx = 0
Ndx = 0
'''''''''''''''''''''''''''''''''''''''''
' Move the items up.
'''''''''''''''''''''''''''''''''''''''''
For SelNdx = FirstSelItem To LastSelItem
Temp = .List(SelNdx)
.RemoveItem SelNdx
.AddItem Temp, Ndx
Ndx = Ndx + 1
Next SelNdx
''''''''''''''''''''''''''''''''
' Now, reselect the moved items.
''''''''''''''''''''''''''''''''
LBXUnSelectAllItems LBX:=LBX
For Ndx = 0 To (LastSelItem - FirstSelItem)
.Selected(Ndx) = True
Next Ndx
End With
End Sub
LBXMoveUp Public Sub LBXMoveUp(LBX As MSForms.ListBox)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LBXMoveUp
' This moves the selected items up one position in the list.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Temp As String ' temporary variable to hold value for swap
Dim Ndx As Long ' index counter for LBX.List
Dim SelNdx As Long ' index of selected items
Dim SelCount As Long ' number of selected items
Dim FirstSelItem As Long ' first selected item index
Dim LastSelItem As Long ' last selected item index
Dim SaveNdx As Long ' saved index to reselect items
''''''''''''''''''''''''
' If list is empty, get
' out now.
''''''''''''''''''''''''
If LBX.ListCount = 0 Then
Exit Sub
End If
''''''''''''''''''''''''''''''''''''
' Ensure the selected items
' are contiguous (no unselected rows
' within selected rows).
''''''''''''''''''''''''''''''''''''
If LBXIsSelectionContiguous(LBX:=LBX) = False Then
Exit Sub
End If
SaveNdx = -1
With LBX
If .ColumnCount > 1 Then
''''''''''''''''''''''''''
' No support for mutliple
' column listboxes.
''''''''''''''''''''''''''
Exit Sub
End If
''''''''''''''''''''''''''''''
' If the list is empty, there
' is nothing to do. Get out.
''''''''''''''''''''''''''''''
If .ListCount = 0 Then
Exit Sub
End If
'''''''''''''''''''''''''''''
' If there is no selected
' item, there is nothing to
' do. Get Out.
'''''''''''''''''''''''''''''
If .ListIndex < 0 Then
Exit Sub
End If
''''''''''''''''''''''''''''''''''''''''''''''''
' Get information about the selected items
' in the list box LBX.
''''''''''''''''''''''''''''''''''''''''''''''''
LBXSelectionInfo LBX:=LBX, SelectedCount:=SelCount, _
FirstSelectedItemIndex:=FirstSelItem, LastSelectedItemIndex:=LastSelItem
''''''''''''''''''''''''''''''''''
' If nothing is selected, get out.
''''''''''''''''''''''''''''''''''
If SelCount = 0 Then
Exit Sub
End If
''''''''''''''''''''''''''''''''''''
' If no items are selected, get out.
' This should be picked up in
' SelCount = 0, but we test here for
' completeness.
''''''''''''''''''''''''''''''''''''
If (FirstSelItem < 0) Or (LastSelItem < 0) Then
Exit Sub
End If
''''''''''''''''''''''''''''''''''''
' If the first selected item is the
' first item in the list, get out.
''''''''''''''''''''''''''''''''''''
If FirstSelItem = 0 Then
Exit Sub
End If
SelNdx = 0
Ndx = 0
For SelNdx = FirstSelItem To LastSelItem
Temp = .List(SelNdx)
.RemoveItem SelNdx
.AddItem Temp, SelNdx - 1
If SaveNdx < 0 Then
SaveNdx = SelNdx
End If
Next SelNdx
LBXUnSelectAllItems LBX:=LBX
For Ndx = SaveNdx - 1 To SaveNdx + (LastSelItem - FirstSelItem - 1)
.Selected(Ndx) = True
Next Ndx
End With
End Sub
LBXSelectAllItems Public Sub LBXSelectAllItems(LBX As MSForms.ListBox)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SelectAllItems
' This procedure selects all items in the listbox LBX.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Ndx As Long
With LBX
''''''''''''''''''''''''
' If list is empty, get
' out now.
''''''''''''''''''''''''
If .ListCount = 0 Then
Exit Sub
End If
For Ndx = 0 To .ListCount - 1
.Selected(Ndx) = True
Next Ndx
End With
End Sub
LBXSelectedItems Public Function LBXSelectedItems(LBX As MSForms.ListBox) As String()
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SelectedItems
' This returns a 0-based array of strings, each of which is a selected
' item in the list box. If LBX is empty, the result is an unallocated
' array. The caller should first call SelectionInfo to determine whether
' there are any selected items prior to calling this procedure.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim SelCount As Long
Dim FirstIndex As Long
Dim LastIndex As Long
Dim SelItems() As String
Dim Ndx As Long
Dim ArrNdx As Long
''''''''''''''''''''''''
' If list is empty, get
' out now.
''''''''''''''''''''''''
If LBX.ListCount = 0 Then
Exit Function
End If
If LBX.ColumnCount > 1 Then
''''''''''''''''''''''''''
' No support for mutliple
' column listboxes.
''''''''''''''''''''''''''
Exit Function
End If
LBXSelectionInfo LBX:=LBX, SelectedCount:=SelCount, _
FirstSelectedItemIndex:=FirstIndex, LastSelectedItemIndex:=LastIndex
''''''''''''''''''''''''''''''''''''
' If nothing was selected, get out.
''''''''''''''''''''''''''''''''''''
If SelCount = 0 Then
Exit Function
End If
ArrNdx = 0
'''''''''''''''''''''''''''''''''''
' Redim the result array to the
' number of selected items. This
' array is 0-based.
'''''''''''''''''''''''''''''''''''
ReDim SelItems(0 To SelCount - 1)
With LBX
For Ndx = 0 To .ListCount - 1
If .Selected(Ndx) = True Then
SelItems(ArrNdx) = .List(Ndx)
ArrNdx = ArrNdx + 1
End If
Next Ndx
End With
LBXSelectedItems = SelItems
End Function
LBXSelectionInfo
Public Sub LBXSelectionInfo(LBX As MSForms.ListBox, ByRef SelectedCount As Long, _
ByRef FirstSelectedItemIndex As Long, ByRef LastSelectedItemIndex As Long)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SelectionInfo
' This procedure provides information about the selected
' items in the listbox referenced by LBX. The variable
' SelectedCount will be populated with the number of selected
' items, the variable FirstSelectedItem will be popuplated
' with the index number of the first (from the top down)
' selected item, and the variable LastSelectedItem will return
' the index number of the last (from the top down) selected
' item. If no item(s) are selected or ListIndex < 0,
' SelectedCount is set to 0, and FirstSelectedItem and
' LastSelectedItem are set to -1.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FirstItem As Long: FirstItem = -1
Dim LastItem As Long: LastItem = -1
Dim SelCount As Long: SelCount = 0
Dim Ndx As Long
''''''''''''''''''''''''
' If list is empty, get
' out now.
''''''''''''''''''''''''
If LBX.ListCount = 0 Then
Exit Sub
End If
With LBX
If .ListCount = 0 Then
SelectedCount = 0
FirstSelectedItemIndex = -1
LastSelectedItemIndex = -1
Exit Sub
End If
If .ListIndex < 0 Then
SelectedCount = 0
FirstSelectedItemIndex = -1
LastSelectedItemIndex = -1
Exit Sub
End If
For Ndx = 0 To .ListCount - 1
If .Selected(Ndx) = True Then
If FirstItem < 0 Then
FirstItem = Ndx
End If
SelCount = SelCount + 1
LastItem = Ndx
End If
Next Ndx
End With
SelectedCount = SelCount
FirstSelectedItemIndex = FirstItem
LastSelectedItemIndex = LastItem
End Sub
LBXSort Public Sub LBXSort(LBX As MSForms.ListBox, Optional FirstIndex As Long = -1, _
Optional LastIndex As Long = -1, Optional Descending As Boolean = False, _
Optional SelectedItemsOnly As Boolean = False)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LBXSort
' This calls QSortInPlace to sort the entries in the list box. If FirstIndex is
' supplied and is greater than or equal to 0, only entries at and after
' FirstIndex are sorted. If FirstIndex is omitted or less than 0, the sort starts
' with the first entry in the list box. This parameter is ignored if
' SelectedItemsOnly is True. If LastIndex is supplied and is greater than or equal
' to 0, only items at and before LastIndex are sorted. This parameter is ignored
' if SelectedItemsOnly is True. Descending is True or False indicating whether the
' list should be sorted in desending order. The default is False, indicating
' ascending order. SelectedItemsOnly is True or False indicating whether only the
' selected items should be sorted. If omitted, the items between (inclusive)
' FirstIndex and LastIndex are sorted. If FirstIndex > LastIndex, the entire
' list is sorted.
' If SelectedItemsOnly is True, then the procedure uses LBXIsSelectionContiguous to
' ensure that the selected items are contiguous. If they are contiguous, they are
' sorted. If they are not contiguous, the item are not sort.
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Arr() As String
Dim First As Long
Dim Last As Long
Dim Ndx As Long
''''''''''''''''''''''''
' If list is empty, get
' out now.
''''''''''''''''''''''''
If LBX.ListCount = 0 Then
Exit Sub
End If
''''''''''''''''''''''''''''''''''''
' Ensure the selected items
' are contiguous (no unselected rows
' within selected rows).
''''''''''''''''''''''''''''''''''''
If SelectedItemsOnly = True Then
If LBXIsSelectionContiguous(LBX:=LBX) = False Then
Exit Sub
End If
End If
With LBX
If .ColumnCount > 1 Then
''''''''''''''''''''''''''
' No support for mutliple
' column listboxes.
''''''''''''''''''''''''''
Exit Sub
End If
''''''''''''''''''''''''''''''''''''''
' If FirstIndex is less than 0, set
' it to 0, the first item in the list.
''''''''''''''''''''''''''''''''''''''
If FirstIndex < 0 Then
First = 0
Else
First = FirstIndex
End If
''''''''''''''''''''''''''''''''''''''
' If LastIndex is less than 0, set
' it to ListCount -1 , the last item
' in the list.
''''''''''''''''''''''''''''''''''''''
If LastIndex < 0 Then
Last = .ListCount - 1
Else
Last = LastIndex
End If
If First = Last Then
''''''''''''''''''''''''''''''''''
' There is nothing to do. Get out.
''''''''''''''''''''''''''''''''''
Exit Sub
End If
If .ListCount <= 1 Then
''''''''''''''''''''''''''''''''''
' There is nothing to do. Get out.
''''''''''''''''''''''''''''''''''
Exit Sub
End If
'''''''''''''''''''''''''''''''''''''
' Load the list contents into an array.
'''''''''''''''''''''''''''''''''''''
ReDim Arr(0 To .ListCount - 1)
For Ndx = 0 To .ListCount - 1
Arr(Ndx) = .List(Ndx)
Next Ndx
'''''''''''''''''''''''''''''''''
' Sort the array.
'''''''''''''''''''''''''''''''''
QSortInPlace InputArray:=Arr, _
LB:=FirstIndex, _
UB:=LastIndex, _
Descending:=Descending, _
CompareMode:=vbTextCompare, _
NoAlerts:=True
''''''''''''''''''''''''''''''''
' Clear the list box and reload
' with the sorted array Arr.
'''''''''''''''''''''''''''''''
.Clear
For Ndx = 0 To (UBound(Arr) - LBound(Arr))
.AddItem Arr(Ndx)
Next Ndx
End With
End Sub
LBXUnSelectAllItems Public Sub LBXUnSelectAllItems(LBX As MSForms.ListBox)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' UnSelectAllItems
' This procedure unselects all items in the listbox LBX.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Ndx As Long
With LBX
If .ListCount = 0 Then
Exit Sub
End If
For Ndx = 0 To .ListCount - 1
.Selected(Ndx) = False
Next Ndx
End With
End Sub
LBXUnSelectIfNotContiguous Public Sub LBXUnSelectIfNotContiguous(LBX As MSForms.ListBox, ListIndex As Long)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LBXUnSelectIfNotContiguous
' This procedure prevents selection of non-contiguous items in the specified
' list box.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim FirstItem As Long
Dim LastItem As Long
Dim SelCount As Long
Dim Ndx As Long
Dim UnSelectedFound As Boolean
''''''''''''''''''''''''
' If list is empty, get
' out now.
''''''''''''''''''''''''
If LBX.ListCount = 0 Then
Exit Sub
End If
LBXSelectionInfo LBX:=LBX, SelectedCount:=SelCount, _
FirstSelectedItemIndex:=FirstItem, LastSelectedItemIndex:=LastItem
With LBX
If .ListCount = 0 Then
Exit Sub
End If
For Ndx = FirstItem + 1 To LastItem Step 1
If .Selected(Ndx) = False Then
UnSelectedFound = True
End If
If UnSelectedFound = True Then
.Selected(Ndx) = False
End If
Next Ndx
End With
End Sub
|
||