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

R

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
 
C

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)...
 
R

Ron Rosenfeld

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

I suppose someone might be able to come up with a formula, but much
simpler using a User Defined Function:


To enter this User Defined Function (UDF), <alt-F11> opens
the Visual Basic Editor. Ensure your project is highlighted
in the Project Explorer window. Then, from the top menu,
select Insert/Module and paste the code below into the
window that opens.

To use this User Defined Function (UDF), enter a formula
like

=ParseName(cell_reference)

in some cell.

You may need to add to the list of Titles -- just continue the "|"
delineated list as needed. If some may have a dot following, we can
make changes to take that into account.

Note that this does not have the previously mentioned issue with
failing to recognize the title in "two word" names, such as REV BROWN
or MR SMITH.

=====================================
Option Explicit
Function ParseName(s As String) As String
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "((MR|MS|MRS|REV)\s+)?((\w)\S+?(\s|-(?!\S+$)))"
ParseName = re.Replace(Trim(s), "$1$4$5")
End Function
============================
 
R

Ron Rosenfeld

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

Here's a slight change that handles possiblities like

MR. ALAN JOHN JONES (--> MR A J JONES)

as well as the title DR

================================
Option Explicit
Function ParseName(s As String) As String
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern =
"((MR|MS|MRS|DR|REV)(\.?)(\s+))?((\w)\S+?(\s|-(?!\S+$)))?"
ParseName = re.Replace(Trim(s), "$2$4$6$7")
End Function
=============================
 
R

Ron Rosenfeld

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 !

I would also note that

JOHN DAVID SMITH becomes JOHN D SMITH and not J D SMITH

and

MR. ALAN JOHN JONES becomes MR. A J JONES (I am assuming he would want
the dot dropped)
 
R

Ron Rosenfeld

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

One further modification in case you might have any of the title
letters in lower case:

===============================
Option Explicit
Function ParseName(s As String) As String
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.ignorecase = True
re.Pattern = _
"((MR|MS|MRS|DR|REV)(\.?)(\s+))?((\w)\S+?(\s|-(?!\S+$)))?"
ParseName = UCase(re.Replace(Trim(s), "$2$4$6$7"))
End Function
===================================
 
C

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
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
R

Ron Rosenfeld

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

And here's a variation that takes removes excess spaces between words
which Charabeuh pointed out as a potential problem.

=========================
Option Explicit
Function ParseName(s As String) As String
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.ignorecase = True
re.Pattern = _
"((MR|MS|MRS|REV)(\.?)(\s))?\s*((\w)\S+?(\s|-(?!\S+$)))?"
ParseName = UCase(re.Replace(Trim(s), "$2$4$6$7"))
End Function
==========================
 
R

Ron Rosenfeld

With the corrections that you have suggested and to correct more than one
blank between names:

It seems to work now.

I also changed my regex to handle the "more than one blank between
names" you pointed out:


"((MR|MS|MRS|REV)(\.?)(\s))?\s*((\w)\S+?(\s|-(?!\S+$)))?"


Oh, in your method of doing this, you can simplify and remove your Do
Loop by using the TRIM Worksheet Function:

So:
 
C

Charabeuh

Hello Ron,

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

Charabeuh
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top