Extract Last Name From A Cell

[slink9]

I have a need to extract the last name from a row of cells. The name may be formatted as

John Smith
Mr & Mrs John Smith
Mr & Mrs John Smith, Jr
Mr & Mrs John Smith III

The column is A and I want to extract the last name into column E for last name sorting purposes. Any suggestions????

[Brandtrock]

Stephen,

Here is an example file I have used for my courses. You will have to make adjustments to the column refs, but it shows how to do what you ask. I haven't accounted for the case where there is a comma though. That can be handled with another SUBSTITUTE being nested into the formula though.

Regards,

[Zack Barresse]

Hello Steve,

Chip Pearson has about the best workaround for this that I've come across, found here. His UDF solution looks as follows and handles JR, SR, II, III, IV and any suffix beginning with a number...

Function ParseOutNames(FullName As String) As Variant
Dim FirstName As String
Dim LastName As String
Dim MidInitial As String
Dim Suffix As String
Dim Pos As Integer
Dim Pos2 As Integer
Dim Pos3 As Integer
Pos = InStr(1, FullName, ",", vbTextCompare)
If Pos = 0 Then
    Pos = Len(FullName) + 1
End If
LastName = Trim(Left(FullName, Pos - 1))
Pos2 = InStr(1, LastName, " ", vbTextCompare)
If Pos2 Then
    Pos3 = InStr(Pos2 + 1, LastName, " ", vbTextCompare)
    If Pos3 Then
        Suffix = Right(LastName, Len(LastName) - Pos3)
        LastName = Left(LastName, Pos3 - 1)
    Else
        Suffix = Right(LastName, Len(LastName) - Pos2)
        LastName = Left(LastName, Pos2 - 1)
    End If
End If
Pos2 = InStr(Pos + 2, FullName, " ", vbTextCompare)
If Pos2 = 0 Then
    Pos2 = Len(FullName)
End If
If Pos2 > Pos Then
    FirstName = Mid(FullName, Pos + 1, Pos2 - Pos)
    MidInitial = Right(FullName, Len(FullName) - Pos2)
End If
Pos = InStr(1, LastName, "-", vbTextCompare)
If Pos Then
    LastName = Trim(StrConv(Left(LastName, Pos), vbProperCase)) & _
    Trim(StrConv(Right(LastName, Len(LastName) - Pos), vbProperCase))
Else
    LastName = Trim(StrConv(LastName, vbProperCase))
End If
FirstName = Trim(StrConv(FirstName, vbProperCase))
MidInitial = Trim(StrConv(MidInitial, vbProperCase))
Suffix = Trim(StrConv(Suffix, vbProperCase))
' suffix handling
Select Case UCase(Suffix)
    Case "JR", "SR", "II", "III", "IV", "MD", "PHD", "PH.D", "M.D."
    Case Else
        If Not IsNumeric(Left(Suffix, 1)) Then
            LastName = LastName & " " & Suffix
            Suffix = ""
        End If
End Select
ParseOutNames = Array(LastName, FirstName, MidInitial, Suffix)
End Function

As an example, if you had your names (you posted above) starting in A1, to get the last name in B1, you'd select B1:E1 and enter ...

=ParseOutNames(A1)

Confirm with Ctrl + Shift + Enter, as it's an array formula. This will split the names up. A formula solution for the last name, also found on Chip's site, may look like this ...

=LEFT(A1,IF(ISERROR(FIND(",",A1,1)),LEN(A1),FIND(",",A1,1)-1))

This is also assuming the full name is in A1.



HTH

[slink9]

It works excellently if there is always a postfix on the name (III, Esquire, etc) but fails when there is no postfix. Many in the list do not have one. In that case it displays the entire string after the Mr. or Mrs.
Did I do something wrong?

[slink9]

firefytr,
Thanks. I will try that one now.

[Zack Barresse]

Also, another solution as a routine, not a function, could look like ...

Option Explicit

Sub ParseSpacesPlease()
    Dim cel As Range, rng As Range, i As Long, myVal As String, tmpVal As String
    Set rng = Selection
    For Each cel In rng
        myVal = cel.Value
        cel.Formula = "=TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(" & Chr(34) & _
            myVal & Chr(34) & ",""Jr"",""""),""Sr"",""""),""III"",""""),"","",""""))"
        tmpVal = cel.Value
        For i = Len(tmpVal) To 1 Step -1
            If Mid(tmpVal, i, 1) = Chr(32) Then
                cel.Value = Right(tmpVal, Len(tmpVal) - i)
                Exit For
            End If
        Next i
    Next cel
End Sub

[slink9]

firefytr,
I haven't actually used excel vba since completing the vba course. I can't get the result from the field properly. What is the proper order of steps to get it to work properly?

[Zack Barresse]

For which solution? I've uploaded an example file. The two solutions are based on two different formats of names btw.


...

[slink9]

parsenamesplease does just what I want. It just needs to reside in a cell and be an automatic thing. The person I am creating this for needs as much automated as possible. It will be hard enough to teach him how to sort the list and then merge into a mailing list.

[slink9]

By the way, brandtrock's solution works as long as there is something after the last name, whether it is a space or a suffix.

[Zack Barresse]

So what are you looking for here, a UDF? Or a routine that will guide this person through the process? A userform perhaps?

[slink9]

He needs to be able to enter the name using the normal format into column A with the second, third, and occasionally fourth address lines in the next columns. I am guessing that I need a formula in column E that will automatically extract the name (as brandtrock's does properly with a space or suffix at the end) into column E.
He will then be able to sort this on column E and get an aplhabetical list.
I could have a UDF automatically fire after leaving column A, couldn't I? Which would be easier?

[Zack Barresse]

If that is all he will be entering in that column, I'd suggest a worksheet_change event to enter the data in the relevant column (same row). You could use something like this (if you had the second solution of mine in a standard module) ...

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myVal As String
    If Target.Row < 2 Then Exit Sub 'for header rows
    If Target.Column <> 1 Then Exit Sub 'restrain to col A
    If Target.Value = "" Then
        Cells(Target.Row, 5).Value = ""
    Else
        If Cells(Target.Row, 5).Value = "" Then
            myVal = ParseSpacesPlease(Target.Value)
            Cells(Target.Row, 5).Value = myVal
        End If
    End If
End Sub

And the routine would be changed to a function like this ...

Option Explicit

Public Function ParseSpacesPlease(cel As String)
    Dim i As Long, myVal As String, tmpVal As String, tmpCel As Range
    Set tmpCel = Range("A65536").End(xlUp).Offset(1)
    myVal = cel
    Application.EnableEvents = False
    tmpCel.Formula = "=TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(" & Chr(34) & _
    myVal & Chr(34) & ",""Jr"",""""),""Sr"",""""),""III"",""""),"","",""""))"
    tmpVal = tmpCel.Value
    For i = Len(tmpVal) To 1 Step -1
        If Mid(tmpVal, i, 1) = Chr(32) Then
            cel = Right(tmpVal, Len(tmpVal) - i)
            Exit For
        End If
    Next i
    tmpCel.Clear
    Application.EnableEvents = True
    ParseSpacesPlease = cel
End Function

[slink9]

Excellent.
Still one problem. He has at least one with a II suffix. I added II in the same format already there with another SUBSTITUTE but it didn't work. Is there another (or completely different) mod that needs to be made to handle that suffix?

[slink9]

It didn't work with Jr. but I believe that is an easy fix. There is also a IV and I will need to incorporate that. He is an antiques dealer / appraiser so he has big money clients with big money names.

[Zack Barresse]

Worksheet code ...

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myVal As String
    If Target.Row < 2 Then Exit Sub 'for header rows
    If Target.Column <> 1 Then Exit Sub 'restrain to col A
    If Selection.Count > 1 Then Exit Sub
    If Target.Value = "" Then
        Cells(Target.Row, 5).Value = ""
    Else
        If Cells(Target.Row, 5).Value = "" Then
            myVal = ParseSpacesPlease(Target.Value)
            Cells(Target.Row, 5).Value = myVal
        End If
    End If
End Sub

Updated Function ...

Option Explicit

Public Function ParseSpacesPlease(cel As String)
    Dim i As Long, myVal As String, tmpVal As String, tmpCel As Range
    Set tmpCel = Range("A65536").End(xlUp).Offset(1)
    myVal = cel
    Application.EnableEvents = False
    tmpCel.Formula = "=TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(" & Chr(34) & _
        myVal & Chr(34) & ",""Jr"",""""),""Sr"",""""),""III"",""""),"","",""""),""II"",""""))"
    tmpVal = tmpCel.Value
    For i = Len(tmpVal) To 1 Step -1
        If Mid(tmpVal, i, 1) = Chr(32) Then
            cel = Right(tmpVal, Len(tmpVal) - i)
            Exit For
        End If
    Next i
    tmpCel.Clear
    Application.EnableEvents = True
    ParseSpacesPlease = cel
End Function

[slink9]

I didn't realize that it would not replace the value. All fixed. Thanks.

[Zack Barresse]

Okay. Glad you got it working Steve.

[brettdj]

My attempt with RegExp

Cheers

Dave

Sub GetProperLastName()
Dim MyRange As Range, Cel As Range
Dim RegEx As Object
Set MyRange = Range(Range("A1"), Range("A65336").End(xlUp))
Set RegEx = CreateObject("vbscript.regexp")
RegEx.Global = True
Application.ScreenUpdating = False
For Each Cel In MyRange
'strip out any combination of
'comma OR comma space(s) Or space(s) AND (Jn Or Snr Or III Or II Or IV Or I)
'Note that the longer strings should be replaced first, ie "III" before "II" etc
RegEx.Pattern = "(,|,\s{1,}|\s{1,})(Jr|Snr|III|II|IV|I)$"
Cel.Offset(0, 4) = RegEx.Replace(Cel.Value, "")
'get last word
RegEx.Pattern = ".+(\b[A-Za-z]+)$"
Cel.Offset(0, 4) = RegEx.Replace(Cel.Offset(0, 4), "$1")
Next
Application.ScreenUpdating = True
Set RegEx = Nothing

End Sub

[NateO]

Hello slink9,

I can't tell if you want Jr and III to stay or go away...

if you want a native worksheet function that retains trailing identifiers, try the following in e1 for a1 and copy down:

=RIGHT(A1,LEN(A1)-FIND(CHAR(1),SUBSTITUTE(A1," ",CHAR(1),LEN(A1)-LEN(SUBSTITUTE(A1," ",""))-MIN(SUMPRODUCT((LEN(A1)-LEN(SUBSTITUTE(A1,{"Jr","III","IV","V","VI"},"")))),1))))

This is the first part to a longer function post here:
http://www.puremis.net/excel/Masters..._Nate.shtml#Q7

You can stack more trailing identifiers in the array if you like (in the braces: {}). The trailing identifiers shouldn't throw your sort off by much.