Split Text (reverse Concatenate)

[srezac]

Hi, I'm trying to take the text from one column and split it up into multiple columns. I tried to use the Data>Text to columns but the problem is there is no uniform length or spacing between each cell. I have 2000+ entries like this. Some examples are shown below.

6 COUSINS COVE LN
355 WILLOW AV
6 DEMSHIRE TERR
GALWAY CRT
27 JENKINS AV
2479 RTE 350
649 WATER ST E
140 N SULLIVAN RD

These are basically all addresses and I want to break each one apart into separate columns
UNIT_ID, ST_NM_PREF, ST_NM_BASE, ST_TYP, ST_NM_SUFF
Some description of each column:
UNIT_ID = the number before the text, occasionally is blank
ST_NM_PREF = this is the prefix of the address, usually a directional indicator such as N, S, E W, may be blank, but between the UNIT_ID and ST_NM_BASE
ST_NM_BASE = this is the name of the street, usually after the unit ID or prefix if included and before the st_typ, can contain 1 or more words with multiple spaces
ST_TYP = this is the street type indicator that follows the base name, for example RD, AV, LN, DR, ST, may be blank
ST_NM_SUFF = this is the suffix of the address, usually a directional indicator such as N, S, E W, may be blank but usually falls after the ST_TYP

I'm under the impression there is really not way to create a single formula to be able to separate these but if it is possible any help would be appreciated.

An alternative if the above won't work would be to break it twice simply separating the UNIT_ID from everything else.
The two columns I would be looking for to break it into would be UNIT_ID and ST_NAME. Again I would use the text to columns in excel but as you can see above the unit_id is not uniform in length all the way through.

If both cases are possible please provide a resolution for each.

Thanks and best regards.

 

[ColinKJ]

Hi srezac,

Based on the sample data you provided, the following VBA would do it

Sub SplitData()
R = Sheets(1).Range("A65536").End(xlUp).Row
ct = 1
For a = 1 To R
If a = 7 Then Stop
Tx = Sheets(1).Cells(a, 1)
x = 1
If IsNumeric(Mid$(Tx, x, 1)) = True Then
st = x: ct = 1: x = x + 1
w:
If IsNumeric(Mid$(Tx, x, 1)) = True Then x = x + 1: ct = ct + 1: GoTo w
RR = Sheets(2).Range("A65536").End(xlUp).Row + 1
Sheets(2).Cells(RR, 1) = Mid$(Tx, st, ct) 'UNIT_ID
Tx = Mid$(Tx, st + ct + 1)
x = 1
End If
 
If Mid$(Tx, x + 1, 1) = " " Then
Sheets(2).Cells(RR, 2) = Mid$(Tx, x, 1) 'ST_NM_PREF
Tx = Mid$(Tx, x + 2)
End If
 
If Mid$(Tx, Len(Tx) - 1, 1) = " " Then
Select Case Mid$(Tx, Len(Tx), 1)
Case "N", "S", "E", "W"
Sheets(2).Cells(RR, 5) = Mid$(Tx, Len(Tx), 1)  'ST_NM_SUFF
Tx = Mid$(Tx, 1, Len(Tx) - 2)
End Select
End If
x = Len(Tx)
w1:
If Mid$(Tx, x, 1) <> " " Then x = x - 1: GoTo w1
Sheets(2).Cells(RR, 4) = Mid$(Tx, x + 1) 'ST_TYP
Sheets(2).Cells(RR, 3) = Mid$(Tx, 1, x - 1) 'ST_NM_BASE
Next a
End Sub

If you put your data list in column A of sheet 1, and run the code,the results are shown on sheet 2.

I've put together an example WB called "Seperate Adds.xls", which you can download from:

http://www.box.net/shared/yyuzgkly1r

ColinKJ

 

[ColinKJ]

Hi srezac,

Sorry, the line:

If a = 7 Then Stop

Should be removed from the code, it was just put in when I was testing/debuging.

ColinKJ