Sorting a Cell (string) In Ascending order

[Avaya]

Hi all,

I'd appreciate any help that can be provided in sorting a single cell (string) in an ascending result.

For instance, the cell value would contain "8009543200".
The result I'd like returned "0000234589".

Again, thanks for your help.

 

[shg]

Welcome to the board.

Function AnaSort(sInp As String, Optional bUniq As Boolean = False) As String
    ' shg 2008-1216
 
    ' Returns the characters of sInp in alpha order: AnaSort("amaze") = "aaemz"
    ' with option to return unique characters only:  AnaSort("amaze", True) = "aemz"
    Dim i       As Long             ' index to string characters
    Dim aiNum(0 To 255) As Long     ' count of characters by code
    Dim iAsc    As Long             ' index to aiNum
 
    For i = 1 To Len(sInp)
        iAsc = Asc(Mid(sInp, i, 1))
        aiNum(iAsc) = aiNum(iAsc) + 1
    Next i
 
    If bUniq Then
        For iAsc = 0 To 255
            If aiNum(iAsc) Then AnaSort = AnaSort & Chr$(iAsc)
        Next iAsc
    Else
        For iAsc = 0 To 255
            AnaSort = AnaSort & String$(aiNum(iAsc), Chr$(iAsc))
        Next iAsc
    End If
End Function

E.g., =AnaSort(A1)

 

[Avaya]

Thanks for all your help, works perfect....

 

[shg]

You're welcome, glad it worked for you. Here's another alternative:

Function StrSort(sInp As String, Optional bCaseSens As Boolean = False) As String
    ' shg 2008
    ' Insertion-sorts sInp
    
    Dim i As Long
    Dim j As Long
    Dim s As String
    
    If bCaseSens Then StrSort = sInp Else StrSort = LCase(sInp)
    
    For i = 2 To Len(sInp)
        s = Mid(StrSort, i, 1)
        
        For j = i - 1 To 1 Step -1
            If Mid(StrSort, j) < s Then Exit For
            Mid(StrSort, j + 1) = Mid(StrSort, j, 1)
        Next j
        
        Mid(StrSort, j + 1) = s
    Next i
End Function

 

[Avaya]

Worked perfect.... Seems the latest will lower case the result though - no biggie.. Thanks again

 

[mikerickson]

This is another

Function SortedString(aString As String, Optional Descending As Boolean) As String
    Dim strLeft As String, strRight As String
    Dim chrPivot As String, chrVar As String
    Dim i As Long
    
    chrPivot = Left(aString, 1)
    
    For i = 2 To Len(aString)
        chrVar = Mid(aString, i, 1)
        If ((StrComp(chrVar, chrPivot, vbTextCompare) = -1) Or _
            ((StrComp(chrVar, chrPivot, vbTextCompare) = 0) And (chrVar < chrPivot))) Xor Descending Then
            strLeft = chrVar & strLeft
        Else
            strRight = strRight & chrVar
        End If
    Next i
    
    If 1 < Len(strLeft) Then strLeft = SortedString(strLeft)
    If 1 < Len(strRight) Then strRight = SortedString(strRight)
    SortedString = strLeft & chrPivot & strRight

End Function

 

[shg]

Seems the latest will lower case the result though

Easy to change;

Function StrSort(sInp As String, Optional bCaseSens As Boolean = False) As String
    ' shg 2008, 2011
    ' Insertion-sorts sInp
 
    Dim i         As Long
    Dim j         As Long
    Dim s         As String
    Dim iComp     As Long
 
    StrSort = sInp
    iComp = IIf(bCaseSens, vbBinaryCompare, vbTextCompare)
 
    For i = 2 To Len(sInp)
        s = Mid(StrSort, i, 1)
        For j = i - 1 To 1 Step -1
            If StrComp(Mid(StrSort, j, 1), s, iComp) <= 0 Then Exit For
            Mid(StrSort, j + 1) = Mid(StrSort, j, 1)
        Next j
        Mid(StrSort, j + 1) = s
    Next i
End Function

 

[snoopyhr]

here is not so clean but none macro version.

Excel Workbook
	A	B
13	Original	Sorted
14	8009543200	0000234589
15	2439070100	0000123479
16	20750320100	0000122357
Sheet5

 

[MikeWx]

If the desired result is a text value with the leading zeros, you can modify snoopyhr's neat array formula to add the missing leading zeros as follows:

=[COLOR=red]RIGHT(REPT("0",LEN(A14))&[/COLOR]SUM(SMALL(MID($A14,ROW(INDIRECT("1:"&LEN($A14))),1)*1,ROW(INDIRECT("1:"&LEN($A14))))/10^ROW(INDIRECT("1:"&LEN($A14))))*MAX(10^ROW(INDIRECT("1:"&LEN($A14))))[COLOR=red],LEN(A14))[/COLOR]

Mike

 

[snoopyhr]

Thanks for new and improved wonderful