Creating a salutation from a postal title


Posted by Mike on June 13, 2000 7:48 AM

I have imported a series of postal titles that I need
to strip out the intials in order to use the title and
surnames for the Dear etc for use in a mail merge letter.

Detailed below is an example of what I have in cell
a1:a5.

Mr I C & Mrs E Butler
Mrs L Mcpherson
Mrs J B Watt
Mr J & Mrs A Gray
Mr J W & Mrs A Barrett

The results I need to obtain are:-

Mr & Mrs Butler
Mrs Mcpherson
Mrs Watt
Mr & Mrs Gray
Mr & Mrs Barrett

Does anyone out there have any ideas?

Posted by Mike on June 14, 0100 1:39 AM

8.0 97
Mike

Posted by Mike on June 19, 0100 1:51 AM

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.

Posted by Ryan on June 13, 0100 9:15 AM

Which version of excel are you using, b/c XL2000 has a new feature that will make it easier.
Ryan



Posted by Ryan on June 16, 0100 3:20 PM

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