[VB6] Sort List/ComboBox with Options

[LaVolpe]

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

 ' 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

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

[LaVolpe]

A quick way, without any effort, to sort dates, using the ItemData property.

1. The dates must be just dates, no times. The reason is that a date variable is a Double vs Long type. The listbox and combobox ItemData property is a Long not a Double. In the Double, date value is the whole number and time is the decimal portion.

a. Using the new function, add the date, string-formatted however you wish.
b. The ItemData should be added as follows, to force a Long: Int(DateVariable)
c. Remember to toggle the function's byItemData to True when adding the item or when re-sorting.

 ' example
 SortLstCboBoxItem Combo1, Format(Date, "Short Date"), Int(Date), , , True

2. Another way to ensure proper sorting of a date is to format the date so it can be sorted numerically or as text. Most common method is adding strings to a listbox/combobox like yyyymmdd