Hello all,

I am attempting to sort text within a cell. The text will mainly be
numbers, but the numbers may have some additional alpha characters in
front of it which do not affect the sorting order as only the numeric
values do. For instance, if I have the following

67432, 34321, 43456, imp41431, 644, imj1123

The sorted items should look like the following

644, imj1123, 34321, imp41431, 43456, 67432

I did find a thread entitled "alphabetizing/sorting text within a
cell", but did doesn't exactly do what I need. Also, I really don't
want a function per se as I need to the text in the cell to be reorder,
but not reorder in another cell. Perhaps some sort of macro might do
the trick? At this point, it is beyond my current knowledge of Excel so
any help would be greatly appreciated.

Mark

Hi Mark,

You could use 'Text to Columns' delimited option to put your
data into separate cells then sort the cells the way you want
and then recombine the data to a single cell by concatenating.

e.g.
original data in A1
Use text to columns
Data is now in cells A1,B1,C1,D1,E1,F1
Now sort your data how you wish.
Then in G1 put this formula
=A1&", "&B1&", "&C1&", "&D1&", "&E1&", "&F1
Now select columns A1 to F1 (entire columns) and delete them
Your data will now be sorted and back in place in cell A1.

HTH
Martin

wrote:
Hello all,

I am attempting to sort text within a cell. The text will mainly be
numbers, but the numbers may have some additional alpha characters in
front of it which do not affect the sorting order as only the numeric
values do. For instance, if I have the following

67432, 34321, 43456, imp41431, 644, imj1123

The sorted items should look like the following

644, imj1123, 34321, imp41431, 43456, 67432

I did find a thread entitled "alphabetizing/sorting text within a
cell", but did doesn't exactly do what I need. Also, I really don't
want a function per se as I need to the text in the cell to be reorder,
but not reorder in another cell. Perhaps some sort of macro might do
the trick? At this point, it is beyond my current knowledge of Excel so
any help would be greatly appreciated.

Mark

Hi Mark,

this worked for me...

Public Sub SortCellStrings()
Dim rngSortRange As Range
Set rngSortRange = Application.InputBox( _
"Select the range of cells for internal sorting", _
"Sort Cell Contents", Selection.Address, , , , , 8)
Dim rngCell As Range
Dim StrSubStrings() As String
Dim strNumPart As String
Dim vaArray() As Variant
Dim lNum As Long
Dim I As Integer
Dim J As Integer
For Each rngCell In rngSortRange
StrSubStrings = Split(rngCell.Value, ", ")
For I = 1 To UBound(StrSubStrings)
For J = 1 To Len(StrSubStrings(I))
Select Case Mid(StrSubStrings(I), J, 1)
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
strNumPart = strNumPart & Mid(StrSubStrings(I), J,
1)
End Select
Next J
ReDim Preserve vaArray(2, I) As Variant
vaArray(1, I) = StrSubStrings(I)
vaArray(2, I) = CLng(strNumPart)
strNumPart = ""
Next I
BubbleSort vaArray:=vaArray
ReDim strFinal(1 To UBound(vaArray, 2)) As String
For I = 1 To UBound(vaArray, 2)
strFinal(I) = vaArray(1, I)
Next I
rngCell.Value = Join(strFinal, ", ")
Next rngCell
End Sub


Public Sub BubbleSort(vaArray() As Variant)
Dim J As Integer, k As Integer, l As Integer, n As Integer, t$, u$
n = UBound(vaArray, 2)
For l = 1 To n
J = l
For k = J + 1 To n
If vaArray(2, k) <= vaArray(2, J) Then
J = k
End If
Next k
If l < J Then
t$ = vaArray(2, J)
u$ = vaArray(1, J)
vaArray(2, J) = vaArray(2, l)
vaArray(1, J) = vaArray(1, l)
vaArray(2, l) = t$
vaArray(1, l) = u$
End If
Next l
End Sub


It uses the VBA Split method to convert the delimited (delimiter is
hard coded as the string ", " ie comma then space) cell contents into
an array. That array is then sorted by the BubbleSort Sub. The sorted
array is then converted back to a delimited string by the VBA join
method which is then placed into the original cell.

Try the code out on a backup copy of your data.

To use the code, first paste it into a standard module, then you can
either run the code then select the range of cells for sorting or make
the selection before running the code.

Ken Johnson

Oops!

Sorry about this, But I didn't notice the disappearance of one of the
substrings due to a bit of confusion with the split method returning a
zero base array, while the other arrays were one base.

this version retains all substrings...

Public Sub SortCellStrings()
Dim rngSortRange As Range
Set rngSortRange = Application.InputBox( _
"Select the range of cells for internal sorting", _
"Sort Cell Contents", Selection.Address, , , , , 8)
Dim rngCell As Range
Dim StrSubStrings() As String
Dim strNumPart As String
Dim vaArray() As Variant
Dim lNum As Long
Dim I As Integer
Dim J As Integer
For Each rngCell In rngSortRange
StrSubStrings = Split(rngCell.Value, ", ")
For I = 0 To UBound(StrSubStrings)
For J = 1 To Len(StrSubStrings(I))
Select Case Mid(StrSubStrings(I), J, 1)
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
strNumPart = strNumPart & Mid(StrSubStrings(I), J,
1)
End Select
Next J
ReDim Preserve vaArray(2, I + 1) As Variant
vaArray(1, I + 1) = StrSubStrings(I)
vaArray(2, I + 1) = CLng(strNumPart)
strNumPart = ""
Next I
BubbleSort vaArray:=vaArray
ReDim strFinal(0 To UBound(vaArray, 2)) As String
For I = 0 To UBound(vaArray, 2) - 1
strFinal(I) = vaArray(1, I + 1)
Next I
rngCell.Value = Join(strFinal, ", ")
Next rngCell
End Sub


Public Sub BubbleSort(vaArray() As Variant)
Dim J As Integer, k As Integer, l As Integer, n As Integer, t$, u$
n = UBound(vaArray, 2)
For l = 0 To n
J = l
For k = J + 1 To n
If vaArray(2, k) <= vaArray(2, J) Then
J = k
End If
Next k
If l < J Then
t$ = vaArray(2, J)
u$ = vaArray(1, J)
vaArray(2, J) = vaArray(2, l)
vaArray(1, J) = vaArray(1, l)
vaArray(2, l) = t$
vaArray(1, l) = u$
End If
Next l
End Sub

Ken Johnson

Ken,

Sorry for the long response, but thank you very much for the code as
it works very nice. Thanks a lot!.

Mark


Ken Johnson wrote:
Oops!

Sorry about this, But I didn't notice the disappearance of one of the
substrings due to a bit of confusion with the split method returning a
zero base array, while the other arrays were one base.

this version retains all substrings...

Public Sub SortCellStrings()
Dim rngSortRange As Range
Set rngSortRange = Application.InputBox( _
"Select the range of cells for internal sorting", _
"Sort Cell Contents", Selection.Address, , , , , 8)
Dim rngCell As Range
Dim StrSubStrings() As String
Dim strNumPart As String
Dim vaArray() As Variant
Dim lNum As Long
Dim I As Integer
Dim J As Integer
For Each rngCell In rngSortRange
StrSubStrings = Split(rngCell.Value, ", ")
For I = 0 To UBound(StrSubStrings)
For J = 1 To Len(StrSubStrings(I))
Select Case Mid(StrSubStrings(I), J, 1)
Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"
strNumPart = strNumPart & Mid(StrSubStrings(I), J,
1)
End Select
Next J
ReDim Preserve vaArray(2, I + 1) As Variant
vaArray(1, I + 1) = StrSubStrings(I)
vaArray(2, I + 1) = CLng(strNumPart)
strNumPart = ""
Next I
BubbleSort vaArray:=vaArray
ReDim strFinal(0 To UBound(vaArray, 2)) As String
For I = 0 To UBound(vaArray, 2) - 1
strFinal(I) = vaArray(1, I + 1)
Next I
rngCell.Value = Join(strFinal, ", ")
Next rngCell
End Sub


Public Sub BubbleSort(vaArray() As Variant)
Dim J As Integer, k As Integer, l As Integer, n As Integer, t$, u$
n = UBound(vaArray, 2)
For l = 0 To n
J = l
For k = J + 1 To n
If vaArray(2, k) <= vaArray(2, J) Then
J = k
End If
Next k
If l < J Then
t$ = vaArray(2, J)
u$ = vaArray(1, J)
vaArray(2, J) = vaArray(2, l)
vaArray(1, J) = vaArray(1, l)
vaArray(2, l) = t$
vaArray(1, l) = u$
End If
Next l
End Sub

Ken Johnson

Hi Mark,

You're welcome.
Thanks for the feedback.

Ken Johnson