Sort range of values within a cell

[Chlwls808]

Hi,
A bit complex question..

Because Excel don't allow sorting values inside one cell, I'm trying to use a UDF to handle the sorting. The below module is suppose to help me do it in alphabetical order of a given list of items contained in a cell.

Function SortWithinCell(CelltoSort As Range, DelimitingCharacter As String, IncludeSpaces As Boolean) As String
CelltoSortString = WorksheetFunction.Substitute(CelltoSort.Value, " ", "")
MyArray = Split(CelltoSortString, DelimitingCharacter)
    For N = 0 To UBound(MyArray)
        For M = 1 To UBound(MyArray)
            
                If MyArray(M) < MyArray(M - 1) Then
                    TempValue = MyArray(M)
                    MyArray(M) = MyArray(M - 1)
                    MyArray(M - 1) = TempValue
                End If

        Next M
    Next N
For N = 0 To UBound(MyArray)
    SortWithinCell = SortWithinCell & MyArray(N) & DelimitingCharacter
Next N
SortWithinCell = Left(SortWithinCell, Len(SortWithinCell) - 1)
If IncludeSpaces = True Then SortWithinCell = WorksheetFunction.Substitute(SortWithinCell, ",", ", ")
End Function

But suppose you have a list that looks like this:

33AA21 33AB21 34AC32 36AE12 36AF12

The main goal is to sort it numerically based on first two digit - Highest to lowest, then alphabetically AA to ZZ.. the next numbers aren't relevant.

Appreciate any feedback on the above.

Thanks!

 

[Chlwls808]

Function jec(cell As String, delimiter As String) As String
  With CreateObject("system.collections.arraylist")
    For Each it In Split(cell, delimiter)
      .Add it
    Next
      .Sort
      .Reverse
      jec = Join(.toarray)
  End With
End Function

Very close, the output on the function comes out to:

which wasn't quite what I am looking for. The alphabetical order must remain as is.

expected outcome:
36AE12 36AF12 34AC32 33AA21 33AB21

 

[Fluff]

Would it be too difficult to tweak it a little to sort numbers highest to lowest, while keeping the Alphabetical order as is?

It is certainly not a simple "tweak" as you would need to split the 1st 2 characters from each string, whilst keeping them "tied" to the original string.

 

[JEC]

Hard one for sure!

 

[Fluff]

Shame the OP doesn't have 365, then it could be done quite easily with a formula.

 

[JEC]

@Fluff did you manage to produce the desired outcome with an office 365 formula?
I think I have it like this:

=SORT(--LEFT(MID(H23,{1;8;15;22;29},6),2),,-1)&SORT(RIGHT(MID(H23,{1;8;15;22;29},6),4),,,-1)

 

[JEC]

Nope not working properly

 

[Chlwls808]

It is certainly not a simple "tweak" as you would need to split the 1st 2 characters from each string, whilst keeping them "tied" to the original string.

Hard one for sure!

Understood! I'll make the best out of the solution I have! Thanks gurus, this was so helpful!

 

[Fluff]

Bit of a bodge, but how about

Function Chlwls(Txt As String, Delim As String) As String
   Dim Sp As Variant, Sp2 As Variant, Tmp As Variant
   Dim i As Long, j As Long
   
   Sp = Split(Txt, Delim)
   ReDim Sp2(UBound(Sp))
   For i = 0 To UBound(Sp)
      Sp2(i) = Left(Sp(i), 2) & UBound(Sp) - i
   Next i
   For i = 0 To UBound(Sp2) - 1
      For j = i + 1 To UBound(Sp2)
         If Sp2(j) > Sp2(i) Then
            Tmp = Sp2(i): Sp2(i) = Sp2(j): Sp2(j) = Tmp
            Tmp = Sp(i): Sp(i) = Sp(j): Sp(j) = Tmp
         End If
      Next j
   Next i
   Chlwls = Join(Sp, Delim)
End Function

 

[Fluff]

Ignore the previous code, it won't work if you have more than 9 substrings.
Try this instead

Function Chlwls(txt As String, Delim As String) As String
   Dim Sp As Variant, Sp2 As Variant, Tmp As Variant
   Dim i As Long, j As Long
   
   Sp = Split(txt, Delim)
   ReDim Sp2(UBound(Sp))
   For i = 0 To UBound(Sp)
      Sp2(i) = Left(Sp(i), 2) & Chr(UBound(Sp) - i + 65)
   Next i
   For i = 0 To UBound(Sp2) - 1
      For j = i + 1 To UBound(Sp2)
         If Sp2(j) > Sp2(i) Then
            Tmp = Sp2(i): Sp2(i) = Sp2(j): Sp2(j) = Tmp
            Tmp = Sp(i): Sp(i) = Sp(j): Sp(j) = Tmp
         End If
      Next j
   Next i
   Chlwls = Join(Sp, Delim)
End Function

 

[Chlwls808]

Ignore the previous code, it won't work if you have more than 9 substrings.
Try this instead

Function Chlwls(txt As String, Delim As String) As String
   Dim Sp As Variant, Sp2 As Variant, Tmp As Variant
   Dim i As Long, j As Long
  
   Sp = Split(txt, Delim)
   ReDim Sp2(UBound(Sp))
   For i = 0 To UBound(Sp)
      Sp2(i) = Left(Sp(i), 2) & Chr(UBound(Sp) - i + 65)
   Next i
   For i = 0 To UBound(Sp2) - 1
      For j = i + 1 To UBound(Sp2)
         If Sp2(j) > Sp2(i) Then
            Tmp = Sp2(i): Sp2(i) = Sp2(j): Sp2(j) = Tmp
            Tmp = Sp(i): Sp(i) = Sp(j): Sp(j) = Tmp
         End If
      Next j
   Next i
   Chlwls = Join(Sp, Delim)
End Function

Man, you guys are amazing. It works like a charm! Thank you so much! I'd love to be good at this as you one day.