change full name to: title + initial(s) + surname

[robzrob]

Hi, I want a formula for

MR ALAN JOHN JONES to become MR A J JONES
MS PEGGY-SUE CARTER to become MS P-S CARTER
MRS JANET SMYTH-JONES to become MRS J SMYTH-JONES
REV PETER DEREK BROWN to become REV P D BROWN
DAVID SMITH to become D SMITH

etc

 

[Charabeuh]

Hello,

In my opinion, a formula would be difficult to build.

You could try a user defined function like that:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function sConvert(xS As String) As String
Dim xTab, Ytab, xNB As Integer
Dim I As Integer, J As Integer, Ifrom as integer

xTab = Split(xS, " ")
xNB = UBound(xTab, 1) - LBound(xTab, 1) + 1

Select Case xNB
Case 0
sConvert = ""
Case 1
sConvert = xS
Case Is >= 2
Ifrom = IIf(xNB = 2, 0, 1)
For I = Ifrom To UBound(xTab, 1) - 1
Ytab = Split(xTab(I), "-")
For J = 0 To UBound(Ytab, 1)
Ytab(J) = Left(Ytab(J), 1)
Next J
xTab(I) = Join(Ytab, "-")
Next I
sConvert = Join(xTab, " ")
End Select
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

This function will work with:
MR ALAN JOHN JONES becomes MR A J JONES
MS PEGGY-SUE CARTER becomes MS P-S CARTER
MS PEGGY-SUE JOHN-PETER CARTER becomes MS P-S J-P CARTER
MRS JANET SMYTH-JONES becomes MRS J SMYTH-JONES
REV PETER DEREK BROWN becomes REV P D BROWN
DAVID SMITH becomes D SMITH
SMITH becomes SMITH
JOHN-PETER CARTER becomes J-P CARTER

But not with
REV BROWN (which become R BROWN)
Cannot guess from two words whether the first name is a title or a name

Hope it will help you !




"robzrob" <[email protected]> a écrit dans le message de groupe de
discussion :
(e-mail address removed)...

 

[Charabeuh]

With the corrections that you have suggested and to correct more than one
blank between names:
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function sConvert2(xS As String) As String
Dim xTab, Ytab, xNB As Integer, Titles
Dim I As Integer, J As Integer, Ifrom As Integer
Dim Title As Boolean

Titles = "MR/MS/MRS/DR/REV"

Do
J = Len(xS)
xS = Trim(Replace(xS, " ", " "))
Loop Until J = Len(xS)
If Len(xS) = 0 Then Exit Function

xTab = Split(UCase(xS), " ")
xNB = UBound(xTab, 1) - LBound(xTab, 1) + 1

If Right(xTab(0), 1) = "." Then xTab(0) = Left(xTab(0), Len(xTab(0)) - 1)
If InStr(Titles, xTab(0)) > 0 Then Title = True Else Title = False

Select Case xNB
Case 0
sConvert2 = ""
Case 1
sConvert2 = xTab(0)
Case Is > 1
If Title Then Ifrom = 1 Else Ifrom = 0
For I = Ifrom To UBound(xTab, 1) - 1
Ytab = Split(xTab(I), "-")
For J = 0 To UBound(Ytab, 1)
Ytab(J) = Left(Ytab(J), 1)
Next J
xTab(I) = Join(Ytab, "-")
Next I
sConvert2 = Join(xTab, " ")
End Select
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

 

[Charabeuh]

Hello Ron,

Please, do you have some links that describe and explain what is regex and
how to use it ?

Charabeuh

 

[Charabeuh]

Thank you !

A good web site is: http://www.regular-expressions.info/

also look at
http://social.msdn.microsoft.com/Forums/en-US/regexp/threads

although that is more useful if you are using .NET than VBA.

and there is a microsoft web site that gives useful information on
using regular expressions in VBA, but I don't have the link handy.

 

[robzrob]

A good web site is:  http://www.regular-expressions.info/

also look athttp://social.msdn.microsoft.com/Forums/en-US/regexp/threads

although that is more useful if you are using .NET than VBA.

and there is a microsoft web site that gives useful information on
using regular expressions in VBA, but I don't have the link handy.

Thanks all

 

[robzrob]

Thank you !

"Ron Rosenfeld" <[email protected]> a écrit dans le message de groupe de
discussion : (e-mail address removed)...








- Show quoted text -

Thanks all.