Link to home
Start Free TrialLog in
Avatar of John Carney
John CarneyFlag for United States of America

asked on

Is there a way to sort numbers in one cell from smallest to largest?

I have a range of cells that have entries with numbers separated by spaces. Like this "'11 12 1 2 3 4 5 6 7 8".  Is there a macro that will sort them smallest to largest: "'1 2 3 4 5 6 7 8 11 12". If it makes it easier I could replace the spaces with commas or something. .

I know I can do this with text to columns, sort the resulting range and then overwrite the cell with a concatenation. In this working code I'm doing that with cell F735
Dim cel As Range, lenStr As Long, xNum As Long, sumAll As String
lenStr = Len([F735])
xNum = lenStr - Len(Replace([F735], " ", "")) + 1

[F735].TextToColumns Destination:=[AL735], DataType:=xlDelimited _
    , TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
    Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True
Range("AL735:AU735").Sort key1:=[AL735], order1:=xlAscending
sumAll = "=AL735&"" ""&AM735&"" ""&AN735&"" ""&AO735&"" ""&AP735&"" ""&AQ735&"" ""&AR735&"" ""&AS735&"" ""&AT735&"" ""&AU735"
[F735] = Evaluate(sumAll)

Open in new window

But even with this, I would need a way to determine how many items should be in the array to run the text to columns. The first 3 lines are my attempt do that but I'm not sure how to carry that over into the array code.

The ideal solution would be to do it all in code, but the text to columns workaround would be fine too.

Any thoughts?

Thanks,
john
Avatar of Saurabh Singh Teotia
Saurabh Singh Teotia
Flag of India image

John,

Can you post your sample file as it will become easy to write a macro for you..

Saurabh...
John,
Here is a macro that will sort the values in the active cell into ascending numeric order:
Sub SortMe()
'Sorts the active cell in ascending order
Dim temp As Variant, v As Variant
Dim i As Long, j As Long, n As Long
Dim b As Boolean
Const delimiter As String = " "
v = Split(ActiveCell.Value, delimiter)
n = UBound(v)
If n > 0 Then
    For i = 0 To n
        b = False
        For j = 1 To n
            If CDbl(v(j)) < CDbl(v(j - 1)) Then
                b = True
                temp = v(j)
                v(j) = v(j - 1)
                v(j - 1) = temp
            End If
        Next
        If b = False Then Exit For
    Next
    ActiveCell.Value = Join(v, delimiter)
End If
End Sub

Open in new window

It won't make a lot of difference at best but this is probably faster. It assumes the data in in column A. If it's not in "A" then change lines 7, 9 and 11.

Sub SortCell()
Dim strParts() As String
Dim lngLastRow As Long
Dim lngRow As Long
Dim lngNdx As Long

lngLastRow = Range("A1048576").End(xlUp).Row
For lngRow = 1 To lngLastRow
    strParts = Split(Cells(lngRow, "A"))
    QuickSort strParts, LBound(strParts), UBound(strParts)
    Cells(lngRow, "A") = Join(strParts, " ")
Next
End Sub
Private Sub QuickSort(C() As String, ByVal First As Long, ByVal Last As Long)

Dim Low As Long, High As Long
Dim MidValue As String

Low = First
High = Last
MidValue = C((First + Last) \ 2)

Do
While C(Low) < MidValue
Low = Low + 1
Wend

While C(High) > MidValue
High = High - 1
Wend

If Low <= High Then
Swap C(Low), C(High)
Low = Low + 1
High = High - 1
End If
Loop While Low <= High

If First < High Then QuickSort C, First, High
If Low < Last Then QuickSort C, Low, Last
End Sub
Private Sub Swap(ByRef A As String, ByRef B As String)
Dim T As String

T = A
A = B
B = T
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of byundt
byundt
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Martin Liss' code puts the 11 before the 2.
Good catch.

I changed QuickSort to sort numerically rather than by string value.

Private Sub QuickSort(C() As String, ByVal First As Long, ByVal Last As Long)

Dim Low As Long, High As Long
Dim MidValue As String

Low = First
High = Last
MidValue = C((First + Last) \ 2)
Debug.Print MidValue
Do
While Val(C(Low)) < Val(MidValue)
Low = Low + 1
Wend

While Val(C(High)) > Val(MidValue)
High = High - 1
Wend

If Low <= High Then
Swap C(Low), C(High)
Low = Low + 1
High = High - 1
End If
Loop While Low <= High

If First < High Then QuickSort C, First, High
If Low < Last Then QuickSort C, Low, Last
End Sub

Open in new window

Avatar of John Carney

ASKER

byundt, it's been so long I've forgotten your fist name, but the code works perfectly, thanks! However there are several lines I don't understand and if you don't mind when I have time to form intelligent questions I want to find out.

Martin, I couldn't test yours (and this is where I show how pathetic my understanding of certain basic things is after all these years), but I can't figure out how to debug or even run your Private Sub. I can't assign it to a button, and i can't F8 my way through it or run it from within VBE.

~ John
SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thanks, Martin, I got it to work. I want to award the majority of the points to Brad since his code worked right out of the box for me and it is faster and more compact, but I really appreciate your sticking with it and posting the workbook. I hope the 100 points is okay.

~ John
I have no problem with what you decided.