Extracting right-hand word from text

[No Waiting]

I have a simply problem, but am having trouble finding the solution!

I have a column like this -

Mr & Mrs John Brown
Jane Smith
Mr Tom Gray
Peter Hancock
Miss Jill Bradley-Smith

and need to split it into two columns, thus

Mr & Mrs John
Jane
Mr Tom
Peter
Miss Jill

and

Brown
Smith
Gray
Hancock
Bradley-Smith

All help very gratefully received!

 

[erik.van.geit]

Hello, No waiting,

You will find a solution here.
Take care: the starting data may not have ending spaces.

http://www.mrexcel.com/board2/viewtopic.php?t=35513

kind regards,
Erik

 

[jindon]

Hi,

the code will split ;
Title in Col.C
First Name in Co.D and
Last Name in Col.E

Sub split_name()
Dim i As Integer, a(7) As String, b() As String
Dim x As Integer, y As String, r As Range
a(0) = "MR."
a(1) = "MR "
a(2) = "MRS."
a(3) = "MRS "
a(4) = "MISS "
a(5) = "MS."
a(6) = "MS "
a(7) = "& "
Application.ScreenUpdating = False
With ActiveSheet
    .Columns("c:e").Clear
For Each r In .Range("a1", .Range("a65536").End(xlUp))
    For i = LBound(a) To UBound(a)
        If InStr(UCase(r), a(i)) > 0 Then
            x = x + 1
        End If
    Next
    b = Split(r)
    If x = 0 Then
            For i = LBound(b) To UBound(b)
                .Cells(r.Row, i + 4) = b(i)
            Next
        Else
            For i = 0 To x - 1
                y = y & b(i) & " "
            Next
            .Cells(r.Row, 3) = Left(y, Len(y) - 1)
            ii = 5
            For i = x To UBound(b)
                .Cells(r.Row, i + 4 - x) = b(i)
            Next
    End If
    x = 0
    y = ""
    Erase b
Next
End With
Erase a
Application.ScreenUpdating = True
End Sub

if you want to add more items to the title array like DR PROF etc
simply increase number of a(7) in the Dim statement like a(11) and add
a(8)="DR."
a(9)="DR "
a(10)="PROF."
a(11)="PROF "

rgds,
jindon

 

[No Waiting]

Many thanks guys - you've saved the day

Have a drink on me !