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