Sort digits within a cell

[tiredofit]

I would like to sort the digits in a cell in ascending order.

So for example, I want:

6,4,5

to be converted to:

4,5,6

I found this code:

https://www.mrexcel.com/board/threads/vba-sort-alphanumeric-comma-delimited-text-in-a-cell.1135586/

and I call it as follows:

Dim a As Variant

a = SortCSVString(Sheet1.Cells(1, 1).Value2

but it crashes on this line:

Sub SortArray(ByRef arr() As String)

    Dim temp As Variant
    Dim i As Long
    Dim j As Long
   
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If CLng(Mid(Trim(arr(i)), 2)) > CLng(Mid(Trim(arr(j)), 2)) Then '***** CRASHES HERE
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
End Sub

with an error message:

Run-time error '13':

Type mismatch

I typed this into the Immediate Window:

?mid(Trim(arr(i)),2)

and it retuned blank, so I added the CLng and the same error message appeared.

Same error for:

?mid(Trim(arr(j)),2)

Can someone point out what's wrong.

Thanks

 

[tiredofit]

It depends on which index you're on. So if you're on the index for l, it checks all the indexes up to l (i.e. i, j,k, l) so 4. But that brings up a point... I don't believe you need those anymore because your col B is sorted. I originally had it there because col B wasn't sorted so it should work after you remove all those IF statements.

Sub FindCombinations()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets(1) ' Change the sheet name if necessary
    Dim colA As Range
    Dim colB As Range
    Dim lastRow As Long
    Dim i As Long, j As Long, k As Long, l As Long
    Dim sum As Long
    Dim results As Object
    Dim threshold As Integer
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    Set colA = ws.Range("A1:A" & lastRow)
    Set colB = ws.Range("B1:B" & lastRow)
    Set results = CreateObject("Scripting.Dictionary")
 
    threshold = 50
    For i = 1 To lastRow
        If colB(i).Value > threshold Then
            results(SortString(colA(i).Value)) = True
            GoTo overThreshold
        End If
        For j = i + 1 To lastRow
            sum = colB(i).Value + colB(j).Value
            If sum > threshold Then
                results(SortString(colA(i).Value & "," & colA(j).Value)) = True
            Else
                For k = j + 1 To lastRow
                    sum = colB(i).Value + colB(j).Value + colB(k).Value
                    If sum > threshold Then
                        results(SortString(colA(i).Value & "," & colA(j).Value & "," & colA(k).Value)) = True
                    Else
                        For l = k + 1 To lastRow
                            sum = colB(i).Value + colB(j).Value + colB(k).Value + colB(l).Value
                            If sum > threshold Then
                                results(SortString(colA(i).Value & "," & colA(j).Value & "," & colA(k).Value & "," & colA(l).Value)) = True
                            End If
                        Next l
                    End If
                Next k
            End If
        Next j
overThreshold:
    Next i
    ' Output results
    Dim outputRow As Long
    outputRow = 1
    Dim key As Variant
    For Each key In results.Keys
        ws.Cells(outputRow, "C").Value = key
        outputRow = outputRow + 1
    Next key
End Sub
 
Function SortString(inputString As String) As String
    Dim arr() As String
    arr = Split(inputString, ",")
    Dim temp As String
    Dim i As Long, j As Long
    ' Bubble sort algorithm
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If Val(arr(i)) > Val(arr(j)) Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
    SortString = Join(arr, ",")
End Function

I was curious because intuitively, I questioned the significance of FOUR.

Yes, I came up with the idea of sorting the numbers, otherwise, it would've been more difficult.

Once again, many thanks for your continued help on this problem.

 

[tiredofit]

I was curious because intuitively, I questioned the significance of FOUR.

Yes, I came up with the idea of sorting the numbers, otherwise, it would've been more difficult.

Once again, many thanks for your continued help on this problem.

Afraid I've found a scenario where your code fails:

1​	10​
2​	10​
3​	10​
4​	10​
5​	10​
6​	10​
7​	10​
8​	10​
9​	10​
10​	10​

I think it's because you only have FOUR loops:

For i = 1 To lastRow
For j = i + 1 To lastRow
For k = j + 1 To lastRow
For l = k + 1 To lastRow

 

[tiredofit]

Afraid I've found a scenario where your code fails:

1​	10​
2​	10​
3​	10​
4​	10​
5​	10​
6​	10​
7​	10​
8​	10​
9​	10​
10​	10​

I think it's because you only have FOUR loops:

For i = 1 To lastRow
For j = i + 1 To lastRow
For k = j + 1 To lastRow
For l = k + 1 To lastRow

Think you need to add this:

For m = l + 1 To lastRow
                                    If colB(i).Value > threshold Or colB(j).Value > threshold Or colB(k).Value > threshold Or colB(l).Value > threshold Or colB(m).Value > threshold Then
                                        results(SortString(colA(i).Value & "," & colA(j).Value & "," & colA(k).Value & "," & colA(l).Value & "," & colA(m).Value)) = True
                                    End If
                                    sum = colB(i).Value + colB(j).Value + colB(k).Value + colB(l).Value + colB(m).Value
                                    If sum > threshold Then
                                        results(SortString(colA(i).Value & "," & colA(j).Value & "," & colA(k).Value & "," & colA(l).Value & "," & colA(m).Value)) = True

 

[tiredofit]

Think you need to add this:

For m = l + 1 To lastRow
                                    If colB(i).Value > threshold Or colB(j).Value > threshold Or colB(k).Value > threshold Or colB(l).Value > threshold Or colB(m).Value > threshold Then
                                        results(SortString(colA(i).Value & "," & colA(j).Value & "," & colA(k).Value & "," & colA(l).Value & "," & colA(m).Value)) = True
                                    End If
                                    sum = colB(i).Value + colB(j).Value + colB(k).Value + colB(l).Value + colB(m).Value
                                    If sum > threshold Then
                                        results(SortString(colA(i).Value & "," & colA(j).Value & "," & colA(k).Value & "," & colA(l).Value & "," & colA(m).Value)) = True

Else
                                        For n = m + 1 To lastRow
                                            If colB(i).Value > threshold Or colB(j).Value > threshold Or colB(k).Value > threshold Or colB(l).Value > threshold Or colB(m).Value Or colB(n).Value > threshold Then
                                                results(SortString(colA(i).Value & "," & colA(j).Value & "," & colA(k).Value & "," & colA(l).Value & "," & colA(m).Value & "," & colA(n).Value)) = True
                                            End If
                                            sum = colB(i).Value + colB(j).Value + colB(k).Value + colB(l).Value + colB(m).Value + colB(n).Value
                                            If sum > threshold Then
                                                results(SortString(colA(i).Value & "," & colA(j).Value & "," & colA(k).Value & "," & colA(l).Value & "," & colA(m).Value & "," & colA(n).Value)) = True
                                            End If
                                        Next n
                                    End If
                                Next m