Ron's code works for me on your example cell contents and covers both your
requirements..............the in-cell sort and the components split to column B

You are to run only one macro........Sub SortCell()

The second Sub is called from that.

Did you copy Ron's code directly from the posting?


Gord Dibben MS Excel MVP


On Sun, 26 Jun 2011 13:38:16 +0100, "wulfit" wrote:

Thanks for that. Both macros are almost working - when I run them I'm
getting an error message "Compile error: Sub or Function not defined" -
referring to SingleBubbleSort. I'm sure this is fairly easy to fix but I
don't have enough knowlege yet about VB to do that.

"Ron Rosenfeld" wrote in message
.. .
On Sat, 25 Jun 2011 19:40:23 +0100, "wulfit"
wrote:

Is it possible to -

1. Re-arrange values in a single cell into numerical order within the
cell? - to explain - cell A1 looks like 25 4 11 29 16 - how do I make it
look like - 4 11 16 25 29
2. Copy each of a number of values in a single cell to it's own cell? - to
explain, using the above example - cell B1 would end up with the value 25,
B2 would have 4, B3 would have 11, and so on

I'm sure this can be done through a VB scripts and thus a macros, but I
don't have quite enough knowledge to write them

There are faster sorting routines, but a simple bubblesort should be
adequate for this.

To enter this Macro (Sub), <alt-F11 opens the Visual Basic Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

To use this Macro (Sub), first select the cell(s) to process.
The cells do not need to be contiguous
There is no testing for overwriting
The routine clears the column adjacent to the selected cell before
running.

Then <alt-F8 opens the macro dialog box. Select the macro by name, and
<RUN.

=======================================
Option Explicit
Sub SortCell()
Dim c As Range, rg As Range
Dim v As Variant
Dim i As Long
Set rg = Selection
For Each c In rg
v = Split(c.Text)
c.Offset(0, 1).EntireColumn.ClearContents
c.Offset(0, 1).Resize(rowsize:=UBound(v) - LBound(v) + 1) = _
WorksheetFunction.Transpose(v)
For i = LBound(v) To UBound(v)
'enough zero's to be longer than longest number
'if it can vary considerably, we can test for it
v(i) = Format(v(i), "000000")
Next i
SingleBubbleSort v
For i = LBound(v) To UBound(v)
v(i) = CLng(v(i))
Next i
c.Value = Join(v)
Next c
End Sub
'----------------------------------------------------
Sub SingleBubbleSort(TempArray As Variant)
'copied directly from support.microsoft.com
Dim Temp As Variant
Dim i As Integer
Dim NoExchanges As Integer

' Loop until no more "exchanges" are made.
Do
NoExchanges = True

' Loop through each element in the array.
For i = 0 To UBound(TempArray) - 1

' If the element is greater than the element
' following it, exchange the two elements.
If TempArray(i) TempArray(i + 1) Then
NoExchanges = False
Temp = TempArray(i)
TempArray(i) = TempArray(i + 1)
TempArray(i + 1) = Temp
End If
Next i
Loop While Not (NoExchanges)
End Sub
============================