[VB6] Sort List/ComboBox with Options

The code at the bottom of this post can be used to sort a listbox and/or combobox with some sort options. It will work whether the listbox/combobox has the .Sorted property set to True or False.

Here are some of the options
:: Re-Sort Ascending or Descending, whether control is sorted or not
:: Sort list items as Text or Numbers
:: If sorting as Text, sort with case-sensitivity or not
:: Sort on the ItemData property vs the List property
:: Add a new item to the control in the sorted position
:: Limitations:
-- Purposely aborts function if ListCount < 0 (more than 32767 list items)
-- When sorting as numeric, ensure list items can be converted to numbers; else add Error trapping

Sample Calls to the Function

Code:

' adding a new item in descending sort order SortLstCboBoxItem List1, newString, newItemData{Optional}, False ' adding a new item in numerical ascending order SortLstCboBoxItem List1, newString, newItemData{Optional}, True, False ' re-sorting in ascending order using Text sort SortLstCboBoxItem List1, "", , , , , , True

Here is the routine you can copy & paste to your form.
Note that speed can be improved a bit if you rewrite the routine into separate routines.
The less IF statements in a loop, the faster the loop

Code:

Private Function SortLstCboBoxItem(theControl As Object, _ ByVal Item As String, Optional ByVal ItemData As Long = 0&, _ Optional ByVal Ascending As Boolean = True, _ Optional ByVal AsText As Boolean = True, _ Optional ByVal byItemData As Boolean = False, _ Optional ByVal CaseSensitive As Boolean = False, _ Optional ByVal SortAgain As Boolean = False) As Long ' theControl :: a listbox or combobox reference, i.e., List1, Combo1(0), etc ' Item :: the string to be added to the combo/listbox. If SortAgain=True, Item is ignored ' ItemData :: the new item's ItemData property, ignored if Item is ignored ' Ascending :: True for ascending sort; else False for descending sort ' AsText :: True to sort text else false to sort numeric, ignored if byItemData=True ' byItemData :: Sort on .ItemData property vs .List property, AsText is ignored ' CaseSensitive :: if AsText=False or byItemData=True, this is ignored ' SortAgain :: re-sorts or initially sorts the listbox/combobox, Item and ItemData are ignored ' Return value :: ' if SortAgain = False then equivalent value to the list/combo box's .NewIndex property ' if SortAgain = True then return value is undefined Dim UB As Long, LB As Long, newIndex As Long Dim lComp As Long, lSortOrder As Long, lSortType As Long Dim Count As Long, lTestValue As Long, Index As Long Dim numValue As Double, dTestValue As Double Count = theControl.ListCount If SortAgain Then If Count < 2& Then Exit Function ' nothing to sort or a negative ListCount value Index = 1& Count = Count - Index Else If Count = 0& Then ' empty; add this as first item theControl.AddItem Item theControl.ItemData(Count) = ItemData Exit Function ElseIf Count < 0& Then ' can't use negative ListCount/Indexes in binary search below without much more code Exit Function Else Index = Count End If End If If Ascending Then lSortOrder = -1& Else lSortOrder = 1& If CaseSensitive Then lSortType = vbBinaryCompare Else lSortType = vbTextCompare For Index = Index To Count If SortAgain Then Item = theControl.List(Index) ItemData = theControl.ItemData(Index) End If UB = Index LB = 1& If byItemData Then Do Until LB > UB newIndex = LB + ((UB - LB) \ 2&) - 1& lTestValue = theControl.ItemData(newIndex) If ItemData = lTestValue Then lComp = 0& Exit Do Else If ItemData < lTestValue Then lComp = -1& Else lComp = 1& If lComp = lSortOrder Then UB = newIndex Else LB = newIndex + 2& End If Loop ElseIf AsText Then Do Until LB > UB newIndex = LB + ((UB - LB) \ 2&) - 1& lComp = StrComp(Item, theControl.List(newIndex), lSortType) If lComp = 0& Then Exit Do If lComp = lSortOrder Then UB = newIndex Else LB = newIndex + 2& Loop Else ' as numeric numValue = CDbl(Item) Do Until LB > UB newIndex = LB + ((UB - LB) \ 2&) - 1& dTestValue = CDbl(theControl.List(newIndex)) If numValue = dTestValue Then lComp = 0& Exit Do Else If numValue < dTestValue Then lComp = -1& Else lComp = 1& If lComp = lSortOrder Then UB = newIndex Else LB = newIndex + 2& End If Loop End If If lComp = -lSortOrder Then newIndex = newIndex + 1& If SortAgain Then If newIndex < Index Then theControl.AddItem Item, newIndex theControl.ItemData(newIndex) = ItemData theControl.RemoveItem Index + 1 End If Else theControl.AddItem Item, newIndex theControl.ItemData(newIndex) = ItemData End If Next SortLstCboBoxItem = newIndex End Function

Edited: Tweaked to not use VB's Sgn() function. Though it made the code a bit easier, potential of overflows due to addition within the function.
Example: If X is 2147483647& and Y is -1&, then Sgn(X-Y) is Overflow.
Oh well, the tweaks were easy enough. Rather lean towards safety vs buggy.
.