[IncludeBorders/top.htm]

 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
This procedure inverts the selection in a ListBox. Selected items are unselected and unselected items are selected.

    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
This procedure returns True if the list is in sorted order (either ascending or descending, depending on the value of the Descending parameter) or False if the list is not in sorted order.  If the Descending parameter is omitted or False, the test order is ascending. Comparison are done case-insensitive ("a" = "A") if the CompareMode is vbTextCompare (1) or case-sensitive ("a" <> "A") if CompareMode is vbBinaryCompare (0).  You can call this function to determine whether the List needs to be sorted using the LBXSort procedure. If this procedure returns True, there is no need to call LBXSort. Sorting is a relatively expensive operation, especially with lists with many items. This procedure allows you to save the processing time unless the list needs to be sorted.

    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
This procedure returns True if all the selected items in the ListBox are contiguous. That is, all select items are adjacent with no unselect items within the range of the first and last selected items. It returns False if the selected items are not contiguous.

    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
This procedure moves the selected items downwards one row in the ListBox. The selected items must be contiguous.

    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
This procedure moves the selected items to the end of the ListBox. The selected items must be contiguous.

    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
This procedure moves the selected items to the top of the ListBox. The selected items must be contiguous.

    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
This procedure moves the selected items upwards one row in the ListBox. The selected items must be contiguous.

    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
This procedure selects all the items in the ListBox.

    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
This procedure returns an array of Strings, each of which is a selected item in the ListBox. If there are no selected items, the result is an unallocated array. The calling procedure should first call LBXSelectionInfo to determine whether there are any selected items.

    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
This procedure provides the following information about the selected items of the ListBox. It provides this information by populating variables passed in as parameters to the procedure.

  • Count Of Selected Items
  • Index Number Of First Selected Item
  • Index Number Of Last Selected Item
    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
This procedure sorts the ListBox in either ascending or descending order. This procedure can support the entire ListBox, in which case FirstIndex and LastIndex should be omitted or less than 0, or a subset of the ListBox, in which case FirstIndex should be set to the index of the first item to sort  and LastIndex should be set to the index of the last item to sort. If SelectedItemsOnly is True, only the selected rows are sorted, and FirstIndex and LastIndex are ignored. If SelectedItemsOnly is True, the selected items must be contiguous.

    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
This procedure unselects all items in the ListBox.

    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
This procedure unselects the specified item in the ListBox if it is not contiguous with the other selected items in the ListBox. This procedure is intended to be called from the Click or MouseUp event of the ListBox in order to prevent the user from selecting a non-contiguous set of items.

    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

 

     
   
     
[IncludeBorders/bottom.htm]