Sorting data in a cell alphabetically

G

Guest

I have several cells in a column. Each of the cells in that column contain
several codes that are seperated by a space. I need a quick way of
rearranging those codes in alphabetic order. I have a somewhat manual process
now where I copy the cell contents out of the the cell onto another worksheet
and then do a text to columns function and then sort the resulting row and
then concatenate the cells in that row and re-copy the concatenated cell back
to the original worksheet but that takes a lot of time when you have several
hundered cell to do this to. I'm starting to learn macros and have bought a
couple of book on the topic. I'm sure there is a way to totally automate the
process but I'm not sure how. Does anyone have any code suggestions?

Below is a sample of one of my cells.

BCI AAU BCH ACL ACR ACHR ACS BII BIE BIR BIU BICK BICX CBU WBAJ CTU CTE CTMU
CIU CEI BCC DDU DDE D3U D4E BCB ECI ECIE ECO ECOE ECD ECDE ECN ECNT ECE3 ECN2
ECN3 ECS ECSE ECH ECHE ECR ECRE ECP ECAC ECOV ECPU CIR OGI REU GLU DW FMU IRS
LNI LNU VRU ODI RPI RPU IIEC IIDP EWU EWPU EWPD EWCO EWNU EWA EWBU EWBD EWIU
EWMU EWKU EWLU EWRP CIMT CBTM BCRP
 
P

Peo Sjoblom

Why not just copy the cell contents to a new sheet in let's say B1, then use
data>text to columns, delimited then in next step use space as delimiter,
click finish, then select the row with the parsed data, copy it, select A1
and do edit>paste special and select transpose, then sort column A
ascending. If you want a very bad spreadsheet design you could concatenate
the values again using =A1&" "&A21&" "&and so on, copy and paste special as
values in place but I assume you somehow get this data through some file
import since nobody in their right mind would put these in a single cell

--
Regards,

Peo Sjoblom

(No private emails please)
 
O

Otto Moehrbach

Newbie
I agree with Peo that you have a terrible spreadsheet design. But you
have what you have and you asked a question.
Yes, you can automate this. I'll work up some code for you and you'll
get an idea of how to write the code. If you wish, send me, direct via
email, a small file that contains a sample of several of these cells (about
10) as well as the layout of your data. My email address is
(e-mail address removed). Remove the "nop" from this address. HTH Otto
 
D

Dave Peterson

You could use a User Defined Function:

If you (and anyone else using your workbook) are all using xl2k (or higher):

Option Explicit
Function SortText(myStr As String) As String

Dim mySplit As Variant
Dim iCtr As Long
Dim jCtr As Long
Dim Temp As Variant

mySplit = Split(myStr, " ")

For iCtr = LBound(mySplit) To UBound(mySplit) - 1
For jCtr = iCtr + 1 To UBound(mySplit)
If mySplit(iCtr) > mySplit(jCtr) Then
Temp = mySplit(iCtr)
mySplit(iCtr) = mySplit(jCtr)
mySplit(jCtr) = Temp
End If
Next jCtr
Next iCtr

SortText = Join(mySplit, " ")

End Function

=============
If any are using xl97:

Option Explicit
Function SortText(myStr As String) As String

Dim mySplit As Variant
Dim iCtr As Long
Dim jCtr As Long
Dim Temp As Variant

mySplit = Split97(myStr, " ")

For iCtr = LBound(mySplit) To UBound(mySplit) - 1
For jCtr = iCtr + 1 To UBound(mySplit)
If mySplit(iCtr) > mySplit(jCtr) Then
Temp = mySplit(iCtr)
mySplit(iCtr) = mySplit(jCtr)
mySplit(jCtr) = Temp
End If
Next jCtr
Next iCtr

myStr = ""
For iCtr = LBound(mySplit) To UBound(mySplit)
myStr = myStr & " " & mySplit(iCtr)
Next iCtr

SortText = Mid(myStr, 2)


End Function
Public Function ReadUntil(ByRef sIn As String, _
sDelim As String, Optional bCompare As Long _
= vbBinaryCompare) As String
Dim nPos As String
nPos = InStr(1, sIn, sDelim, bCompare)
If nPos > 0 Then
ReadUntil = Left(sIn, nPos - 1)
sIn = Mid(sIn, nPos + Len(sDelim))
End If
End Function
Public Function Split97(ByVal sIn As String, Optional sDelim As _
String, Optional nLimit As Long = -1, Optional bCompare As _
Long = vbBinaryCompare) As Variant
Dim sRead As String, sOut() As String, nC As Integer
If sDelim = "" Then
Split97 = sIn
End If
sRead = ReadUntil(sIn, sDelim, bCompare)
Do
ReDim Preserve sOut(nC)
sOut(nC) = sRead
nC = nC + 1
If nLimit <> -1 And nC >= nLimit Then Exit Do
sRead = ReadUntil(sIn, sDelim)
Loop While sRead <> ""
ReDim Preserve sOut(nC)
sOut(nC) = sIn
Split97 = sOut
End Function

The readuntil and split97 functions were stolen from the MSKB:
http://support.microsoft.com/default.aspx?scid=kb;en-us;188007
HOWTO: Simulate Visual Basic 6.0 String Functions in VB5
 
G

Guest

Thanks Dave but I'm not sure I totally understand how the code you suggested
is used. I don't see anby ref in the code to cells, columns or rows. I'm also
not real sure how to execute the code. Also, all of the users are on office
2003.
 
D

Dave Peterson

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

Short course:

Open your workbook.
Hit alt-f11 to get to the VBE (where macros/UDF's live)
hit ctrl-R to view the project explorer
Find your workbook.
should look like: VBAProject (yourfilename.xls)

right click on the project name
Insert, then Module
You should see the code window pop up on the right hand side

Paste the code in there.

Now go back to excel.
Into a test cell and type:
=SortText(a1)
Where A1 contains one of the strings.
 
G

Guest

Thank you very much for your help Dave!

Dave Peterson said:
If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

Short course:

Open your workbook.
Hit alt-f11 to get to the VBE (where macros/UDF's live)
hit ctrl-R to view the project explorer
Find your workbook.
should look like: VBAProject (yourfilename.xls)

right click on the project name
Insert, then Module
You should see the code window pop up on the right hand side

Paste the code in there.

Now go back to excel.
Into a test cell and type:
=SortText(a1)
Where A1 contains one of the strings.
Click to expand...
 
Top