The routine is excellent. However one or two
variations that fall out. Can you help.
Mr P S Hale & Ms N A Deller
becomes - Mr & Ms Deller
Should be - Mr Hale & Ms Deller
Mr E & Mrs E B J Boye
becomes Mr & Mrs J Boyce
Is it possible to exclude third and fourth
initials.
Mrs G H J L Lomax
becomes Mrs L Lomax
Is it possible to exclude fourth initial. This
should cater for 99.9% of customers.
If you are unable to crack the next one, don't
worry. But its an interesting test!
Mr F C & Mrs V St George
becomes Mr & Mrs George
should be Mr & Mrs St George.
Good Luck.
Mike.
Which version of excel are you using, b/c XL2000 has a new feature that will make it easier.
Ryan
This procedure takes names from column one and puts the extracted information in column
' three. Hope it's what you need. Let me know how it goes.
' Ryan
Sub ExtractNames()
Number = Application.WorksheetFunction.CountA(Range("A:A"))
Dim Done As Boolean
For x = 1 To Number
Name = Cells(x, 1).Value
Firstspace = InStr(1, Name, " ")
Mrsstart = InStr(1, Name, "Mrs")
AndStart = InStr(1, Name, "&")
Done = False
If AndStart = 0 Then
If InStr(Firstspace + 1, Name, " ") > 0 Then
SecondSpace = InStr(Firstspace + 1, Name, " ")
ThirdSpace = InStr(SecondSpace + 1, Name, " ")
Else
Cells(x, 3).Value = Name
Done = True
End If
If ThirdSpace > 0 And Done = False Then
FourthSpace = InStr(ThirdSpace + 1, Name, " ")
If FourthSpace = 0 Then
Cells(x, 3).Value = Left(Name, Firstspace) _
& Right(Name, Len(Name) - ThirdSpace)
Else
Cells(x, 3).Value = Left(Name, Firstspace) _
& Right(Name, Len(Name) - FourthSpace)
End If
ElseIf ThirdSpace = 0 And Done = False Then
Cells(x, 3).Value = Left(Name, Firstspace) _
& Right(Name, Len(Name) - SecondSpace)
End If
Else
If InStr(AndStart + 2, Name, " ") > 0 Then
SecondSpace = InStr(AndStart + 2, Name, " ")
ThirdSpace = InStr(SecondSpace + 1, Name, " ")
End If
If ThirdSpace > 0 Then
FourthSpace = InStr(ThirdSpace + 1, Name, " ")
If FourthSpace = 0 Then
Cells(x, 3).Value = Left(Name, Firstspace) _
& Mid(Name, AndStart, SecondSpace - AndStart + 1) _
& Right(Name, Len(Name) - ThirdSpace)
Else
C