# 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 = "|"

CodeID
DB ID
Revisions

Tuesday
February
20
2024