Remove Middle Initial

[k3homes]

Hey Anyone,

I have a range that contails several names such as:

Smith, John D
Dean, James L & Mouse, Mickey M
Trump, Donald
Wayne, John P
Wayne, Bruce

I am trying to remove all the middle initials, which as you can see,
some cells contain a name with no middle initials, and some cell
contain 2 names each with an initial. I'm wondering what the code
would look like to search each cell in the range for a single
character (ie. the middle initial), ignoring "&", and remove the
initial.

Any help would be much appreciated.

Thank You,
Kyle

 

[paul.robinson]

Hi
Try this. I've used the worksheetfunction TRIM as it does more
trimming than the VBA one!
The code first removes excess spaces and replaces " , " with ", " so
that a comma doesn't get removed in the loop. The loop looks for " * "
where * is a single character and replaces it with a space. This
reduces the length of the string so that must be reset in the loop.
The final if deals with a " *" at the end of the string.

Function StripInitial(NameString As String) As String
Dim StringLength As Long, i As Long
Dim TempString As String

StringLength = Len(NameString)
'remove any double spaces
TempString = Application.WorksheetFunction.Trim(NameString)
'don't treat a comma like a single initial
TempString = Replace(TempString, " , ", ", ")
For i = 1 To StringLength - 2
If Mid(TempString, i, 1) = " " Then
If Mid(TempString, i + 2, 1) = " " Then
TempString = Replace(TempString, Mid(TempString, i, 3), "
")
End If
End If
StringLength = Len(TempString)
Next i
If Mid(TempString, StringLength - 1, 1) = " " Then
TempString = Left(TempString, Len(TempString) - 2)
End If
StripInitial = TempString
End Function

Might need a more thorough test than I gave it.
regards
Paul

 

[paul.robinson]

Hi
This is better! Forgot about leaving the & alone. Also, not a good
idea to change loop parameter in the loop..

Function StripInitial(NameString As String) As String
Dim StringLength As Long, i As Long
Dim TempString As String
StringLength = Len(NameString)
'remove any double spaces
TempString = Application.WorksheetFunction.Trim(NameString)
'don't treat a comma like a single initial
TempString = Replace(TempString, " , ", ", ")
For i = StringLength - 2 To 1 Step -1
If Mid(TempString, i, 1) = " " Then
If Mid(TempString, i + 2, 1) = " " Then
If Mid(TempString, i + 1, 1) <> "&" Then
TempString = Replace(TempString, Mid(TempString, i,
3), " ")
End If
End If
End If
Next i
StringLength = Len(TempString)
If Mid(TempString, StringLength - 1, 1) = " " Then
TempString = Left(TempString, Len(TempString) - 2)
End If
StripInitial = TempString
End Function

You can use it like

For each Cell in MyRange
Cell.Value = StripInitial(Cell.Value)
next Cell

or use it as a worksheetfunction in the normal way
regards
Paul
Paul

 

[Ron Rosenfeld]

Hey Anyone,

I have a range that contails several names such as:

Smith, John D
Dean, James L & Mouse, Mickey M
Trump, Donald
Wayne, John P
Wayne, Bruce

I am trying to remove all the middle initials, which as you can see,
some cells contain a name with no middle initials, and some cell
contain 2 names each with an initial. I'm wondering what the code
would look like to search each cell in the range for a single
character (ie. the middle initial), ignoring "&", and remove the
initial.

Any help would be much appreciated.

Thank You,
Kyle

You can do that with Regular Expressions.

This code will remove any single character that is preceded by another word
consisting of one or more characters. The single character may optionally be
followed by a dot <.>.

To be more precise, the code returns everything except the MI (and optional
".").

==========================================
Option Explicit
Function NoMI(str As String) As String
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.IgnoreCase = True
re.Global = True
re.Pattern = "([A-Z]+)\s\b[A-Z]\b\.?"
NoMI = re.Replace(str, "$1")
End Function
=========================================



--ron

 

[Stefi]

Maybe this is simpler:

Function remmiddle(wholestr)
Dim joinarr()
splitarr = Split(wholestr, " ")
meret = UBound(splitarr)
j = 0
For a = 0 To meret
If Len(splitarr(a)) > 1 Then
ReDim Preserve joinarr(j)
joinarr(j) = splitarr(a)
j = j + 1
End If
Next a
remmiddle = Join(joinarr)
End Function

Regards,
Stefi


„[email protected]†ezt írta:

 

[Ron Rosenfeld]

Hey Anyone,

I have a range that contails several names such as:

Smith, John D
Dean, James L & Mouse, Mickey M
Trump, Donald
Wayne, John P
Wayne, Bruce

I am trying to remove all the middle initials, which as you can see,
some cells contain a name with no middle initials, and some cell
contain 2 names each with an initial. I'm wondering what the code
would look like to search each cell in the range for a single
character (ie. the middle initial), ignoring "&", and remove the
initial.

Any help would be much appreciated.

Thank You,
Kyle

You can do that with Regular Expressions.

This code will remove any single character that is preceded by another word
consisting of one or more characters. The single character may optionally be
followed by a dot <.>.

To be more precise, the code returns everything except the MI (and optional
".").

==========================================
Option Explicit
Function NoMI(str As String) As String
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.IgnoreCase = True
re.Global = True
re.Pattern = "([A-Z]+)\s\b[A-Z]\b\.?"
NoMI = re.Replace(str, "$1")
End Function
=========================================



--ron

One slight change to handle a name like:

James, L. J.

to return James, L.

--------------------------
'Option Explicit
Function NoMI(str As String) As String
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.IgnoreCase = True
re.Global = True
re.Pattern = "([A-Z]+)\.?\s\b[A-Z]\b\.?"
NoMI = re.Replace(str, "$1")
End Function

 

[Ron Rosenfeld]

Hi
This is better! Forgot about leaving the & alone. Also, not a good
idea to change loop parameter in the loop..

Function StripInitial(NameString As String) As String
Dim StringLength As Long, i As Long
Dim TempString As String
StringLength = Len(NameString)
'remove any double spaces
TempString = Application.WorksheetFunction.Trim(NameString)
'don't treat a comma like a single initial
TempString = Replace(TempString, " , ", ", ")
For i = StringLength - 2 To 1 Step -1
If Mid(TempString, i, 1) = " " Then
If Mid(TempString, i + 2, 1) = " " Then
If Mid(TempString, i + 1, 1) <> "&" Then
TempString = Replace(TempString, Mid(TempString, i,
3), " ")
End If
End If
End If
Next i
StringLength = Len(TempString)
If Mid(TempString, StringLength - 1, 1) = " " Then
TempString = Left(TempString, Len(TempString) - 2)
End If
StripInitial = TempString
End Function

You can use it like

For each Cell in MyRange
Cell.Value = StripInitial(Cell.Value)
next Cell

or use it as a worksheetfunction in the normal way
regards
Paul
Paul

Your UDF will remove the First initial for a name like

Franklin, L Justin

and that if the initial is followed by "." , it will not remove them at all.
--ron

 

[Ron Rosenfeld]

Maybe this is simpler:

Function remmiddle(wholestr)
Dim joinarr()
splitarr = Split(wholestr, " ")
meret = UBound(splitarr)
j = 0
For a = 0 To meret
If Len(splitarr(a)) > 1 Then
ReDim Preserve joinarr(j)
joinarr(j) = splitarr(a)
j = j + 1
End If
Next a
remmiddle = Join(joinarr)
End Function

Regards,
Stefi

Your UDF will remove the First initial for a name like

Franklin, L Justin

and if the initial is followed by "." , it will not remove them at all.
--ron

 

[k3homes]

Thank all of you for your responses. The one that worked best for me
was Paul's. I will not have names such as James, L. J. in my range,
but I do appreciate everyones posts.

Thank You,
Kyle

 

[Stefi]

Hi Ron,

I don't understand the first part of your post: my UDF will remove not only
the first but all initials if they are one character long.

No doubt, it will not remove initials followed by "." but none of the
initials in the OP example is followed by ".".

Regards,
Stefi


„Ron Rosenfeld†ezt írta:

 

[Ron Rosenfeld]

Hi Ron,

I don't understand the first part of your post: my UDF will remove not only
the first but all initials if they are one character long.

No doubt, it will not remove initials followed by "." but none of the
initials in the OP example is followed by ".".

Regards,
Stefi

Yours will remove Initials that are not "Middle Initials"

e.g.

Smith, L James

In this case, L is a "first name" initial, not a middle initial, but your
routine returns:

Smith, James
--ron

 

[Stefi]

I see now, I had no idea that one has to take into account that English names
can occur in "Smith, L James" like format that is an initial stands for the
first name followed by an entire name as middle name.

Stefi

„Ron Rosenfeld†ezt írta:

 

[Ron Rosenfeld]

I see now, I had no idea that one has to take into account that English names
can occur in "Smith, L James" like format that is an initial stands for the
first name followed by an entire name as middle name.

Stefi

Parsing names can be very difficult. Even more so considering all the ethnic
variations. And sometimes one must resort to a lookup table.
--ron

 

[Stefi]

That's why the OP has to set up exact rules for a particular parsing!
Stefi


„Ron Rosenfeld†ezt írta: