ANStrSort3

Sort list of texts having cell address by cell address as alphanumeric in Asc or Desc order.
Returns string of all items listed with same separator as passed.
It can sort these strings by having cell addresses then equal sign then whatever in each item of the list check screenshot for example of usage.
This was to fix the issue of wrong sorting that function ANStrSort2 was doing.
It was listing A9 After A13, and A2 after A13, simply because 9 and 2 come after 1.
This function will convert A9 and A2 to A009 and A002 (and A13 to A013), do the sort, then clear those back to A9 and A2.
This way, we get the good of both sides.
Currently, it changes all cell address to 3 digit numbers (A2 to A002, A34 to A034 and A501 to A501). You can change Fix2Len from 3 to 5 to accept sorting of 5 digits rather than 3

Used this to sort list of Rules that the macro will apply to be executed by cell address.

CodeFunctionName

What is this?

Public

Tested

Original Work

Function ANStrSort3(ANStrList, Optional Asc1_Desc2 = 1, Optional Sepa = "|")
    ' Sort list of addresses, respecting number of row
    ' Regular sort (ANStrSort2) will move H4 to be AFTER H10
    ' So H4 will come before H10, not after it
    ' Works for addresses of up to 3 digits in row A1 to ZZZ999
    ' Can add more rows by changing Fix2Len below
    '
    Dim Coo As New Collection
    Ar = Split(ANStrList, Sepa)

'    On Error Resume Next
    ' Adding leading zeros to allow sort alphanumeric
    Fix2Len = 3 ' Max number of characters we are expecting for the row number
    X1 = 0
    For Each Nu In Ar
        If Nu = "" Then GoTo NextAr
        NuCell = CutString(Nu, , "=")
        NuC = GetColumnName(NuCell)
        NuR = Range(NuCell).Row
        If Len(NuR) < Fix2Len Then
            NNu = NuC & Right(String(Fix2Len, "0") & NuR, Fix2Len)
            Ar(X1) = NNu & "=" & CutString(Nu, "=")
        End If
NextAr:
        X1 = X1 + 1
    Next

    X1 = 0 ' Sort Asc
    For Each Nu In Ar
        If Nu = "" Then GoTo NextI
        Nu2 = Nu
        X1 = X1 + 1
        If X1 = 1 Then
            Coo.Add Nu2
            GoTo NextI
        End If
        CooX1 = 0
        Add2B4 = 0
        For Each Cu In Coo
            CooX1 = CooX1 + 1
            If Asc1_Desc2 = 1 Then
                If Nu2 < Cu Then
                    Add2B4 = CooX1
                    Exit For
                End If
            Else
                If Nu2 > Cu Then
                    Add2B4 = CooX1
                    Exit For
                End If
            End If
        Next
        If Add2B4 = 0 Then
            Coo.Add Nu2
        Else
            Coo.Add Nu2, , Add2B4
        End If
NextI:
    Next

    ' Remove leading zeros. Make H04 > H4
    X1 = 0
    For I = 1 To Coo.Count
        NuCell = CutString(Coo(I), , "=")
        NewItem = Range(NuCell).Address(0, 0) & "=" & CutString(Coo.Item(I), "=")
        If I < Coo.Count Then
            Coo.Remove I
            Coo.Add NewItem, , I
        Else
            Coo.Remove I
            Coo.Add NewItem
        End If
    Next

    Rett = ""
    For I = 1 To Coo.Count
        If Rett > "" Then Rett = Rett & Sepa
        Rett = Rett & Coo(I)
    Next
    ANStrSort3 = Rett

    On Error GoTo 0
End Function

ANStrList, Optional Asc1_Desc2 = 1, Optional Sepa = "|"