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
|
||