Take the code below and put it into a code module. Choose the cell to sort
contents on (one at a time) and run this code/macro. I've tried to break
long lines so that it can just be cut and pasted, but you never can tell
about things here until you actually post. Then it's a little late to edit
Sub SortOneCellContents()
'choose the cell with contents
'to be sorted before calling
'this routine
'
'we will assume that the
'separator for character groups
'is the space character
'and that the first character in the
'cell is not a space
'
'that is to say, this routine
'parses, sorts, and puts back together
'a cell content that might look
'something like
'CT NV TN OR DC CA MN
'
Dim RawCellData As String
Dim ToBeSorted() As String
Dim TheSeparator As String
Dim IsSorted As Boolean
Dim BubbleLoop As Integer
Dim SwapHolder As String
If IsEmpty(Selection) Then
MsgBox "Empty Cell"
Exit Sub ' no work to be done
End If
ReDim ToBeSorted(1) 'initialize
TheSeparator = " " ' change if something besides space
RawCellData = Selection.Value
'force space at end of string if one isn't there
'when we start here
If Right(RawCellData, 1) <> TheSeparator Then
RawCellData = RawCellData & TheSeparator
End If
Do Until InStr(RawCellData, TheSeparator) = 0
ToBeSorted(UBound(ToBeSorted)) = _
Left(RawCellData, InStr(RawCellData, TheSeparator) - 1)
If Len(RawCellData) = Len(ToBeSorted(UBound(ToBeSorted))) + 1 Then
RawCellData = "" ' all done
Else ' more work to be done
'remove what we just put into the array
RawCellData = _
Right(RawCellData, Len(RawCellData) - _
(Len(ToBeSorted(UBound(ToBeSorted))) + 1))
End If
'make room for another - will end up being empty
ReDim Preserve ToBeSorted(UBound(ToBeSorted) + 1)
Loop
'now a simple bubble kind of sort to get them in ascending order
Do Until IsSorted = True
IsSorted = True ' not really, but may be later
For BubbleLoop = LBound(ToBeSorted) To UBound(ToBeSorted) - 1
If ToBeSorted(BubbleLoop + 1) < ToBeSorted(BubbleLoop) Then
SwapHolder = ToBeSorted(BubbleLoop)
ToBeSorted(BubbleLoop) = ToBeSorted(BubbleLoop + 1)
ToBeSorted(BubbleLoop + 1) = SwapHolder
IsSorted = False ' wasn't this time thru
End If
Next
Loop
'now rebuild the string
'reuse BubbleLoop counter and RawCellData for this loop also
RawCellData = "" ' just to make sure it's empty
For BubbleLoop = LBound(ToBeSorted) To UBound(ToBeSorted)
If ToBeSorted(BubbleLoop) <> "" Then
RawCellData = RawCellData & ToBeSorted(BubbleLoop) & TheSeparator
End If
Next
Selection.Value = Trim(RawCellData)
End Sub
David said:
Hi
I have lists of postcodes [zip codes] in cells - many codes together in the
same cell - , but only the first two characters. For example: CT, TN, BN,
RH, etc etc.
There are a lot of them. Could someone tell me how to get Excel to order
these alphabetically in each cell that contains them please?
Note..this is not about a single code in its own cell but multiple codes in
a single cell.
Many thanks
David
