Splitting up text between two fields

[Brian]

I have a list of addresses and need to move the suffix
(DR, ST, AVE, CIR, RD) to the cell to the right. Is there
a macro I could program to do this? I have alot of them
and don't really want to do this by hand one at a time.

Thanks.

 

[Frank Kabel]

Hi
is this prefix somehow separated from the rest of the text (e.g. with a
space)?

 

[Brian]

yes, it's the last 'word' of the address and it has a
space in front of it: 123 MAIN ST for example.

 

[Pete McCosh]

Brian,

assuming there are a random number of spaces in your
addresses up to a maximum of ten and the addresses are in
the range A2:A100, here are a few suggestions.

Use Data>>Text to Columns to separate the parts of the
address, placing the result in the range starting at C2.
Then put this formula in B2 and copy down as far as you
need:
=Offset(C2,0,counta(d2:M2)-1,1,1)

This will find the last entry in the ten cells starting at
C2. You can then Copy>>Paste Special>>values to leave the
data you want.

If you don't want to bother with this and are desperate
for a macro, something along these lines should do it
(just vary the source range before you start:

Sub Suffix()

Dim X As Integer
Dim cl As Range

For Each cl In Range("A2:A100").Cells

For X = Len(cl.Value) To 1 Step -1

If Mid(cl.Value, X, 1) = " " Then
cl.Offset(0, 1).Value = Right(cl.Value, Len(cl.Value)-X)
Exit For
End If

Next X
Next cl

End Sub

'Cheers, Pete.

 

[Frank Kabel]

Hi
try the following macro
Sub change_rows()
Dim RowNdx As Long
Dim LastRow As Long
Dim pos as integer

LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).row
For RowNdx = LastRow To 1 Step -1
with Cells(RowNdx, "A")
pos = InStrRev(.value," ")
if pos>0 then
.offset(0,1).value=mid(.value,pos+1,10)
.value=left(.value,pos-1)
end if
End with
Next RowNdx
End Sub

 

[Brian]

Thanks for you help guys! It does exactly what I was
hoping for