IsStringLess

Description:
IsStringLess is a simple function that will compare two strings and tell you if the first is less than the second. Unlike using StrComp(), it will take into account any numbers that appear in the strings. For instance, the two strings "Track 2 - Blues" and "Track 10 - Pop" would sort using StrComp with the 10 first. IsStringLess sorts them as you might want them sorted, with the 2 first.

The example shows how to sort a collection using this function and the clsSort class available elsewhere on this site.

11/23/2003: Removed the need for the comparison function to create a duplicate of each string, speeding up the comparison by about 30%.
 
Code:
Public Function IsStringLess( _
    sString1 As String, _
    sString2 As String) As Boolean

    Dim nPos1 As Long
    Dim nPos2 As Long
    Dim nEndPos1 As Long
    Dim nEndPos2 As Long
    Dim sChar1 As String
    Dim sChar2 As String
    Dim nResult As Long
    
    Do
        nPos1 = nPos1 + 1
        nPos2 = nPos2 + 1
        
        sChar1 = Mid(sString1, nPos1, 1)
        sChar2 = Mid(sString2, nPos2, 1)
        If Len(sChar1) > Len(sChar2) Then
            IsStringLess = False
            Exit Function
        ElseIf Len(sChar2) > Len(sChar1) Then
            IsStringLess = True
            Exit Function
        ElseIf Len(sChar1) = 0 Then
            IsStringLess = False
            Exit Function
        End If
        
        ' See if this part of both strings looks like a number
        If IsNum(sChar1) And IsNum(sChar2) Then
            'Look for the end of the numeric part
            nEndPos1 = nPos1
            Do
                nEndPos1 = nEndPos1 + 1
            Loop While IsNum(Mid(sString1, nEndPos1, 1))
            nEndPos2 = nPos2
            Do
                nEndPos2 = nEndPos2 + 1
            Loop While IsNum(Mid(sString2, nEndPos2, 1))
            
            'Compare the two numbers
            Do
                If nEndPos1 - nPos1 = nEndPos2 - nPos2 Then
                    ' If the lengths of the numbers are
                    ' equal, compare them

                    nResult = StrComp(Mid(sString1, nPos1, nEndPos1 - _
                       nPos1), Mid(sString2, nPos2, nEndPos2 - _
                       nPos2))

                    If nResult = 0 Then
                        nPos1 = nEndPos1 - 1
                        nPos2 = nEndPos2 - 1
                        Exit Do
                    ElseIf nResult = -1 Then
                        IsStringLess = True
                        Exit Function
                    Else
                        IsStringLess = False
                        Exit Function
                    End If
                ElseIf nEndPos1 - nPos1 > nEndPos2 - nPos2 Then
                    'If the first number is longer, make sure it's not
                    '  zero padded, otherwise it's
                    '  bigger

                    If Mid(sString1, nPos1, 1) = "0" Then
                        'If it's zero padded, just ignore the zeros
                        nPos1 = nPos1 + 1
                    Else
                        IsStringLess = False
                        Exit Function
                    End If
                Else
                    'If the second number is longer, make sure it's not
                    '  zero padded, otherwise it's
                    '  bigger

                    If Mid(sString2, nPos2, 1) = "0" Then
                        'If it's zero padded, just ignore the zeros
                        nPos2 = nPos2 + 1
                    Else
                        IsStringLess = True
                        Exit Function
                    End If
                End If
            Loop
        Else
            'One or both of these characters is not a number, so just
            '  compare them as a string

            nResult = StrComp(sChar1, sChar2, vbTextCompare)
            If nResult <> 0 Then
                IsStringLess = (nResult = -1)
                Exit Do
            End If
        End If
    Loop

End Function

Public Function IsNum(s As String) As Boolean
    If Len(s) = 0 Then
        IsNum = False
    Else
        IsNum = Asc(Mid(s, 1, 1)) >= Asc("0") And _
                Asc(Mid(s, 1, 1)) <= Asc("9")
    End If
End Function
 
Sample Usage:
 
Private WithEvents m_sort As clsSort

Private Sub Example()

    Set m_sort = New clsSort
    
    Dim col As Collection
    Set col = New Collection
    
    col.Add "20 - Twenty"
    col.Add "1 - One"
    col.Add "10 - Ten (1)"
    col.Add "2 - Two"
    col.Add "15 - Fifteen"
    col.Add "1 - One (b)"
    col.Add "10 - Ten (2)"
    col.Add "3 - Three"
    col.Add "10 - Ten (100)"
    
    m_sort.Sort col, SortCustom

    Dim vItem As Variant
    For Each vItem In col
        Debug.Print vItem
    Next

    ' Results:
    '1 - One
    '1 - One (b)
    '2 - Two
    '3 - Three
    '10 - Ten (1)
    '10 - Ten (2)
    '10 - Ten (100)
    '15 - Fifteen
    '20 - Twenty

End Sub

Private Sub m_sort_IsLess(obj1 As Variant, obj2 As Variant, _
    bResult As Boolean)

    bResult = IsStringLess(CStr(obj1), CStr(obj2))

End Sub