[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 357
  • Last Modified:

Transposing names in Excel

Hi, I am working on a rather large project with thousands of names involved and I am wondering if there is a command or something that would allow me to transpose names as follows;
Now read:

 Rafaela Sauceda
 Mauricio Munoz
 Phillip Dikes

Would prefer they read:

Sauceda Rafaela
Munoz Mauricio
Dikes Phillips

The names are in one cell.  I use Windows XP, SP3 and Office 2003.
Thanks
0
camtz
Asked:
camtz
  • 9
  • 6
  • 5
  • +2
2 Solutions
 
Ingeborg Hawighorst (Microsoft MVP / EE MVE)Microsoft MVP ExcelCommented:
Hello

try

=MID(A1,FIND(" ",A1&" ")+1,99)&" "&LEFT(A1,FIND(" ",A1&" "))

copy down

cheers, teylyn
0
 
bromy2004Commented:
Try this macro

Sub test()
Dim cel as range
Dim strSplit() as string
Dim strOld as string
Dim strNew as string


For each cel in application.selection
Strsplit=split(cel.value," "_)
Strnew=strsplit(ubound(strsplit))
Redim preserve strsplit(lbound(strsplit),ubound(strsplit)-1)
Strnew=strnew & join(strsplit," ")
Cel.value=strnew
Next cel

End sub

Test it out on a couple first
0
 
camtzAuthor Commented:
You guys are great.  Unfortunately all of that is Greek to me since I've never used a macro.  Is this something that I could do without any programing knowledge or is it totally over my head? - Not that I'm not willing to learn, but could you explain it in English (kidding) so that I could follow along?
Thanks
0
Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
bromy2004Commented:
For teylyn's solution, add a column, put in the formula, and copy/paste over your original data. Then remove the column.

For mine,
Press Alt+F11
Right click on your workbook
Click insert
Click Module
Paste my code into the module and colse the window.

Select the data that you want reversed
Press F8 (I think) to open up the macro's box
Select the macro name (test)
Click run

WARNING: mine Cannot be un-done.
Make sure you have a backup.
And test on 10 or so first to make sure that's the result you want.
0
 
camtzAuthor Commented:
Okay, I'm making progress.  Thanks so much for your patience.  I was able to see the results but unfortunately the names are not at A1 but rather in C2. Column C is where the names are listed and they start below the heading which is in C1.  I tried substituting the A1 for C2 but Microsoft said I had an error.  It could have been because I might not have been in cell C2 when I did it.

Would I be correct in substituting the cell to C2 and using everything else as is?
0
 
Saqib Husain, SyedEngineerCommented:
(This is not for points)

If you have replaced all 4 instances of a1 with c2 then the result should be ok. Your formula should be entered in any column other than column C and then copied down.

Saqib
0
 
Patrick MatthewsCommented:
camtz,

If all of the names are as in your sample, then the other Experts have you well-covered.

Do you have *any* names in your data that have middle names, titles (Mr, Ms, etc), or suffixes (Esq, III, etc)?
0
 
camtzAuthor Commented:
matthewspatrick:
Yes, some of the names have middle initials and they should appear at the end.  Does this change the formula?
0
 
bromy2004Commented:
No it shouldn't.

If your data starts in C2
Add a column in D, so you have a completely blank column.
In D2 (the blank column) put =MID(C2,FIND(" ",C2&" ")+1,99)&" "&LEFT(C2,FIND(" ",C2&" "))
Now D should show it exactly as you want it.

If it isn't showing what you want let us know.
If it is, copy all of column D
Highlight all of column C
Right click and cell in C-> paste special->Values
0
 
Patrick MatthewsCommented:
bromy2004,

I tried your formula on:

Rafaela d. Sauceda
Mauricio f. x. Munoz
Phillip Dikes

It returns:

d. Sauceda Rafaela
f. x. Munoz Mauricio
Dikes Phillip

:)

Patrick
0
 
Patrick MatthewsCommented:
camtz,

Name parsing is actually much harder than it looks.  Please have a look at my article here:

http://www.experts-exchange.com/articles/Programming/Languages/Visual_Basic/Parsing-Names-in-MS-Office-Visual-Basic-6-and-Visual-Basic-for-Applications.html

Using the GetNamePart function from that article, I was able to build this formula, assuming your data start in A2:

=TRIM(GetNamePart(A2,"lname")&" "&GetNamePart(A2,"fname")&" "&GetNamePart(A2,"Mname"))

I used this test data:

Rafaela d. Sauceda
Mauricio f. x. Munoz
Phillip Dikes
Jill Amy St. John


I got back:

Sauceda Rafaela d.
x. Munoz Mauricio f.
Dikes Phillip
St. John Jill Amy

Note that that second one came up wrong.  Basically, when a name part is a compound, it can be devilishly difficult to figure out where, say, a first name ends and a middle name begins, or where a middle name ends.  You will *always* have to eyeball the results, no matter what technique you use, as no technique will be able to cope with every single variable.

If you add the code below to a regular VBA module, you will be able to use GetNamePart in worksheet formulas.

Patrick


Function GetNamePart(NameStr As String, NamePart As String, Optional UseMiddle As Boolean = True, _
    Optional FirstMiddleLast As Boolean = True)
    
    ' Function by Patrick Matthews
    
    ' This code may be freely used or distributed so long as you acknowledge authorship and cite the URL
    ' where you found it
    
    ' This function relies on Regular Expressions.  For more information on RegExp, please see:
    ' http://www.experts-exchange.com/articles/Programming/Languages/Visual_Basic/Parsing-Names-in-MS-Office-Visual-Basic-6-and-Visual-Basic-for-Applications.html
    
    ' This function parses a name string, and depending on the arguments passed to it it returns a
    ' title, first name, middle name, surname, or suffix.
    
    ' This function can be used in any VBA or VB6 project.  It can also be used directly in Excel worksheet
    ' formulae and in Access queries
    
    ' The function takes the following arguments:
    '
    ' 1) NameStr is the full name to be parsed.  Its assumed structure is determined by the FirstMiddleLast
    '       argument
    ' 2) NamePart indicates the portion of the name you want returned.  Valid values (NOT case sensitive):
    '       Title: "TITLE", "HONORIFIC", "T", "H", "1"
    '       First: "FIRST NAME", "FIRSTNAME", "FNAME", "F NAME", "FIRST", "F", "FN", "F N", "2"
    '       Middle: "MIDDLE NAME", "MIDDLENAME", "MNAME", "M NAME", "MIDDLE", "M", "MN", "M N", "3"
    '       Last: "LAST NAME", "LASTNAME", "LNAME", "L NAME", "LAST", "L", "LN", "L N", "SURNAME", "4"
    '       Suffix: "SUFFIX", "5"
    ' 3) UseMiddle indicates whether or not a middle name *might* be present in the NameStr.  If True or
    '       omitted, the function assumes that a middle name *might* be there.  If False, it assumes there
    '       is never a middle name
    ' 4) FirstMiddleLast indicates the order of the name parts.  If True or omitted, the function assumes:
    '       <Title (optional)> <First name> <Middle Name (optional)> <Surname> <Suffix (optional)>
    '       If False, the function assumes:
    '       <Surname> <Suffix (optional)>, <First name> <Middle Name (optional)>
    
    ' Notes:
    ' 1) The function has a prebuilt list of Titles (see GenerateLists function below), which you can modify to
    '       fit your needs.  The Titles string will be embedded in a RegExp Pattern string, so be sure to follow
    '       proper RegExp Pattern syntax
    ' 2) The function will recognize compound titles, as long as they are delimited by spaces
    ' 3) The function has a prebuilt list of Suffixes (see GenerateLists function below), which you can modify to
    '       fit your needs.  The Suffixes string will be embedded in a RegExp Pattern string, so be sure to
    '       follow proper RegExp Pattern syntax
    ' 4) The function will recognize compound suffixes, as long as they are delimited by commas and/or spaces
    ' 5) If you are using True (or omitting) for FirstMiddleLast:
    '       a) It is always assumed that the first name has a single "word"
    '       b) It is always assumed that the middle name, if present, has a single "word"
    '       c) After the function has identfied the title, first name, middle name, and suffix, it assumes that
    '           whatever is left must be the surname/last name
    '       d) Thus, this function will process compound first/middle names incorrectly
    ' 6) If you are using False for FirstMiddleLast:
    '       a) It is always assumed that the last comma in NameStr delimits the <Surname><Suffix> block
    '           from the <Title><First name><Middle name> block
    '       b) Whatever is left in the <Surname><Suffix> block after the suffix has been removed is assumed
    '           to be the last name
    '       c) After the Title is removed from the <Title><First name><Middle name> block, if there is only
    '           one "word", it is the first name.  If there are 2+ "words" and UseMiddle = True or omitted,
    '           then the last word is the middle name, and the rest is the first name
    '       d) Thus, this function will process compound middle names incorrectly, and may erroneously think
    '           a compound first name is a first name and a middle name
    
    Dim Title As String
    Dim FName As String
    Dim MName As String
    Dim LName As String
    Dim Suffix As String
    Dim RegXReturn As Object
    Dim NameArr As Variant
    Dim Counter As Long
    Dim StartsAt As Long
    Dim TitleLen As Long
    Dim LastComma As Long
    Dim Part1 As String
    Dim Part2 As String
    
    Static Titles As String
    Static Suffixes As String
    Static RegX As Object 'holding as a Static variable to improve performance
    
    If Trim(NameStr) = "" Or Trim(NamePart) = "" Then
        GetNamePart = ""
        Exit Function
    End If
    
    If Titles = "" Then Titles = GenerateLists("Titles")
    If Suffixes = "" Then Suffixes = GenerateLists("Suffixes")
        
    ' remove leading and trailing spaces
    
    NameStr = Trim(NameStr)
    
    ' instantiate RegExp if needed (static variable, so it will remain in between calls)
    
    If RegX Is Nothing Then
        Set RegX = CreateObject("VBScript.RegExp")
        With RegX
            .IgnoreCase = True  ' case insensitive
            .Global = True      ' finds all matches, not just first match
        End With
    End If
    
    ' Determine structure of NameStr
    
    If FirstMiddleLast Then
        
        ' NameStr is structured <Title (optional)> <First name> <Middle Name (optional)> <Surname> <Suffix (optional)>
        
        ' Set Pattern to look for titles at beginning of NameStr
        RegX.Pattern = "^(" & Titles & ")\.? +"
        
        ' Look for titles.  Use Do...Loop to allow for compound suffixes, as in "Rev. Mr. Arthur Dimmesdale"
        Do
            Set RegXReturn = RegX.Execute(Mid(NameStr, TitleLen + 1))
            If RegXReturn.Count > 0 Then
                TitleLen = TitleLen + Len(RegXReturn(0))
            Else
                Exit Do
            End If
        Loop
        
        ' Get Title
        Title = Trim(Left(NameStr, TitleLen))
        
        ' Adjust NameStr
        NameStr = Mid(NameStr, TitleLen + 1)
        
        ' Look for suffixes.  Use Do...Loop to allow for compound suffixes, as in "Alfred E. Neumann, PhD, Esq."
        
        ' StartsAt indicates where the suffix(es) start in the NameStr.  Initialize to -1, indicating no suffix
        StartsAt = -1
        
        ' Set Pattern to look for suffix at end of NameStr
        RegX.Pattern = "(, *| +)(" & Suffixes & ")\.?$"
        
        ' Evaluate the NameStr.  As long as a suffix is found in the portion evaluated, reset the StartsAt variable.
        ' When no more suffixes are found, terminate the loop
        Do
            Set RegXReturn = RegX.Execute(Left(NameStr, IIf(StartsAt > -1, StartsAt, Len(NameStr))))
            If RegXReturn.Count > 0 Then
                StartsAt = RegXReturn(0).FirstIndex     ' Recall that FirstIndex starts at position zero, not 1 !!!
            Else
                Exit Do
            End If
        Loop
        
        ' If a suffix is found, then grab the entire suffix
        If StartsAt > -1 Then
            Suffix = Mid(NameStr, StartsAt + 1)
            ' remove comma if applicable
            If Left(Suffix, 1) = "," Then Suffix = Mid(Suffix, 2)
            ' remove possible leading space
            Suffix = Trim(Suffix)
            ' adjust NameStr to remove suffixes
            NameStr = Left(NameStr, StartsAt)
        End If
        
        ' Ensure we have space delimiters for remaining NameStr
        NameStr = Replace(NameStr, ".", ". ")
        
        ' Remove extraneous spaces
        RegX.Pattern = " {2,}"
        NameStr = Trim(RegX.Replace(NameStr, " "))
        
        ' Create zero-based array with remaining "words" in the name
        NameArr = Split(NameStr, " ")
        
        ' First name is always assumed to be in position zero
        FName = NameArr(0)
        
        ' Depending on how many "words" are left and whether middle name is assumed to possibly be there
        ' (UseMiddle argument), grab middle/last names
        
        Select Case UBound(NameArr)
            Case 0
                'no middle or last names
            Case 1
                ' first name and last name
                LName = NameArr(1)
            Case Else
                ' potentially first, middle, and last names are present
                If UseMiddle Then
                    ' position 1 is assumed to be middle name, and positions 2 to N the last name
                    MName = NameArr(1)
                    ' remaining "words" are for last name
                    For Counter = 2 To UBound(NameArr)
                        LName = LName & " " & NameArr(Counter)
                    Next
                    ' drop leading space
                    LName = Trim(LName)
                Else
                    ' assume no middle name, and all remaining words are for the last name
                    For Counter = 1 To UBound(NameArr)
                        LName = LName & " " & NameArr(Counter)
                    Next
                    ' drop leading space
                    LName = Trim(LName)
                End If
        End Select
    
    Else
    
        ' NameStr is structured <Surname> <Suffix (optional)>, <Title (optional)> <First name> <Middle Name (optional)>
        
        ' Find position of last comma
        LastComma = InStrRev(NameStr, ",")
        
        If LastComma > 0 Then
            
            ' Part1 will be <Surname> <Suffix (optional)> block;
            ' Part2 is <Title (optional)> <First name> <Middle Name (optional)>
            Part1 = Trim(Left(NameStr, LastComma - 1))
            Part2 = Trim(Mid(NameStr, LastComma + 1))
        
            ' Look for suffixes.  Use Do...Loop to allow for compound suffixes, as in "Neumann, PhD, Esq., Alfred E."
            
            ' StartsAt indicates where the suffix(es) start in Part1.  Initialize to -1, indicating no suffix
            StartsAt = -1
            
            ' Set Pattern to look for suffix at end of Part1
            RegX.Pattern = "(, *| +)(" & Suffixes & ")\.?$"
            
            ' Evaluate Part1.  As long as a suffix is found in the portion evaluated, reset the StartsAt variable.
            ' When no more suffixes are found, terminate the loop
            Do
                Set RegXReturn = RegX.Execute(Left(Part1, IIf(StartsAt > -1, StartsAt, Len(Part1))))
                If RegXReturn.Count > 0 Then
                    StartsAt = RegXReturn(0).FirstIndex     ' Recall that FirstIndex starts at position zero, not 1 !!!
                Else
                    Exit Do
                End If
            Loop
            
            ' If a suffix is found, then grab the entire suffix
            If StartsAt > -1 Then
                Suffix = Mid(Part1, StartsAt + 1)
                ' remove comma if applicable
                If Left(Suffix, 1) = "," Then Suffix = Mid(Suffix, 2)
                ' remove possible leading space
                Suffix = Trim(Suffix)
                ' adjust Part1 to remove suffixes
                Part1 = Left(Part1, StartsAt)
            End If
            LName = Trim(Part1)
        
            ' Set Pattern to look for titles at beginning of Part2
            RegX.Pattern = "^(" & Titles & ")\.? +"
            
            ' Look for titles.  Use Do...Loop to allow for compound suffixes, as in "Dimmesdale, Rev. Mr. Arthur"
            Do
                Set RegXReturn = RegX.Execute(Mid(Part2, TitleLen + 1))
                If RegXReturn.Count > 0 Then
                    TitleLen = TitleLen + Len(RegXReturn(0))
                Else
                    Exit Do
                End If
            Loop
            
            ' Get Title
            Title = Trim(Left(Part2, TitleLen))
            
            ' Adjust Part2
            Part2 = Mid(Part2, TitleLen + 1)
        
            ' Ensure we have space delimiters for remaining Part2
            Part2 = Replace(Part2, ".", ". ")
            
            ' Remove extraneous spaces
            RegX.Pattern = " {2,}"
            Part2 = Trim(RegX.Replace(Part2, " "))
            
            ' Grab first/middle names from Part2
            If UseMiddle And InStr(1, Part2, " ") > 0 Then
                MName = Mid(Part2, InStrRev(Part2, " ") + 1)
                FName = Left(Part2, InStrRev(Part2, " ") - 1)
            Else
                FName = Part2
            End If
        End If
        
    End If
    
    ' determine function's return value
    
    Select Case UCase(NamePart)
        Case "TITLE", "HONORIFIC", "T", "H", "1"
            GetNamePart = Title
        Case "FIRST NAME", "FIRSTNAME", "FNAME", "F NAME", "FIRST", "F", "FN", "F N", "2"
            GetNamePart = FName
        Case "MIDDLE NAME", "MIDDLENAME", "MNAME", "M NAME", "MIDDLE", "M", "MN", "M N", "3"
            GetNamePart = MName
        Case "LAST NAME", "LASTNAME", "LNAME", "L NAME", "LAST", "L", "LN", "L N", "SURNAME", "4"
            GetNamePart = LName
        Case "SUFFIX", "S", "5"
            GetNamePart = Suffix
        Case Else
            GetNamePart = ""
    End Select
    
    ' destroy object variable
    
    Set RegXReturn = Nothing
    
End Function

Function GetAllNameParts(NameStr As String, Optional UseMiddle As Boolean = True, _
    Optional FirstMiddleLast As Boolean = True)
    
    ' Function by Patrick Matthews
    
    ' This code may be freely used or distributed so long as you acknowledge authorship and cite the URL
    ' where you found it
    
    ' This function relies on Regular Expressions.  For more information on RegExp, please see:
    ' http://www.experts-exchange.com/articles/Programming/Languages/Visual_Basic/Parsing-Names-in-MS-Office-Visual-Basic-6-and-Visual-Basic-for-Applications.html
    
    ' This function parses a name string, and returns a Dictionary object (Microsoft Scripting Runtime) with
    ' keys corresponding to title, first name, middle name, surname, and suffix.  If a name part is missing from the
    ' full name, the Dictionary item associated with that key is a zero-length string.  The keys are:
    ' Title, First, Middle, Last, and Suffix (not case sensitive)
    
    ' This function can be used in any VBA or VB6 project.  However, it cannot be used directly in an Excel
    ' worksheet formula or an Access query
    
    ' The function takes the following arguments:
    '
    ' 1) NameStr is the full name to be parsed.  Its assumed structure is determined by the FirstMiddleLast
    '       argument
    ' 2) UseMiddle indicates whether or not a middle name *might* be present in the NameStr.  If True or
    '       omitted, the function assumes that a middle name *might* be there.  If False, it assumes there
    '       is never a middle name
    ' 3) FirstMiddleLast indicates the order of the name parts.  If True or omitted, the function assumes:
    '       <Title (optional)> <First name> <Middle Name (optional)> <Surname> <Suffix (optional)>
    '       If False, the function assumes:
    '       <Surname> <Suffix (optional)>, <First name> <Middle Name (optional)>
    
    ' Notes:
    ' 1) The function has a prebuilt list of Titles (see GenerateLists function below), which you can modify to
    '       fit your needs.  The Titles string will be embedded in a RegExp Pattern string, so be sure to follow
    '       proper RegExp Pattern syntax
    ' 2) The function will recognize compound titles, as long as they are delimited by spaces
    ' 3) The function has a prebuilt list of Suffixes (see GenerateLists function below), which you can modify to
    '       fit your needs.  The Suffixes string will be embedded in a RegExp Pattern string, so be sure to
    '       follow proper RegExp Pattern syntax
    ' 4) The function will recognize compound suffixes, as long as they are delimited by commas and/or spaces
    ' 5) If you are using True (or omitting) for FirstMiddleLast:
    '       a) It is always assumed that the first name has a single "word"
    '       b) It is always assumed that the middle name, if present, has a single "word"
    '       c) After the function has identfied the title, first name, middle name, and suffix, it assumes that
    '           whatever is left must be the surname/last name
    '       d) Thus, this function will process compound first/middle names incorrectly
    ' 6) If you are using False for FirstMiddleLast:
    '       a) It is always assumed that the last comma in NameStr delimits the <Surname><Suffix> block
    '           from the <Title><First name><Middle name> block
    '       b) Whatever is left in the <Surname><Suffix> block after the suffix has been removed is assumed
    '           to be the last name
    '       c) After the Title is removed from the <Title><First name><Middle name> block, if there is only
    '           one "word", it is the first name.  If there are 2+ "words" and UseMiddle = True or omitted,
    '           then the last word is the middle name, and the rest is the first name
    '       d) Thus, this function will process compound middle names incorrectly, and may erroneously think
    '           a compound first name is a first name and a middle name
    
    Dim Title As String
    Dim FName As String
    Dim MName As String
    Dim LName As String
    Dim Suffix As String
    Dim RegXReturn As Object
    Dim NameArr As Variant
    Dim Counter As Long
    Dim StartsAt As Long
    Dim TitleLen As Long
    Dim LastComma As Long
    Dim Part1 As String
    Dim Part2 As String
    Dim dic As Object
    
    Static Titles As String
    Static Suffixes As String
    Static RegX As Object 'holding as a Static variable to improve performance
    
    If Titles = "" Then Titles = GenerateLists("Titles")
    If Suffixes = "" Then Suffixes = GenerateLists("Suffixes")
    
    Set dic = CreateObject("Scripting.Dictionary")
    With dic
        .CompareMode = 1
        .Add "Title", ""
        .Add "First", ""
        .Add "Middle", ""
        .Add "Last", ""
        .Add "Suffix", ""
    End With
    
    If Trim(NameStr) = "" Then
        Set GetAllNameParts = dic
        Set dic = Nothing
        Exit Function
    End If
    
    ' remove leading and trailing spaces
    
    NameStr = Trim(NameStr)
    
    ' instantiate RegExp if needed (static variable, so it will remain in between calls)
    
    If RegX Is Nothing Then
        Set RegX = CreateObject("VBScript.RegExp")
        With RegX
            .IgnoreCase = True  ' case insensitive
            .Global = True      ' finds all matches, not just first match
        End With
    End If
    
    ' Determine structure of NameStr
    
    If FirstMiddleLast Then
        
        ' NameStr is structured <Title (optional)> <First name> <Middle Name (optional)> <Surname> <Suffix (optional)>
        
        ' Set Pattern to look for titles at beginning of NameStr
        RegX.Pattern = "^(" & Titles & ")\.? +"
        
        ' Look for titles.  Use Do...Loop to allow for compound suffixes, as in "Rev. Mr. Arthur Dimmesdale"
        Do
            Set RegXReturn = RegX.Execute(Mid(NameStr, TitleLen + 1))
            If RegXReturn.Count > 0 Then
                TitleLen = TitleLen + Len(RegXReturn(0))
            Else
                Exit Do
            End If
        Loop
        
        ' Get Title
        Title = Trim(Left(NameStr, TitleLen))
        
        ' Adjust NameStr
        NameStr = Mid(NameStr, TitleLen + 1)
        
        ' Look for suffixes.  Use Do...Loop to allow for compound suffixes, as in "Alfred E. Neumann, PhD, Esq."
        
        ' StartsAt indicates where the suffix(es) start in the NameStr.  Initialize to -1, indicating no suffix
        StartsAt = -1
        
        ' Set Pattern to look for suffix at end of NameStr
        RegX.Pattern = "(, *| +)(" & Suffixes & ")\.?$"
        
        ' Evaluate the NameStr.  As long as a suffix is found in the portion evaluated, reset the StartsAt variable.
        ' When no more suffixes are found, terminate the loop
        Do
            Set RegXReturn = RegX.Execute(Left(NameStr, IIf(StartsAt > -1, StartsAt, Len(NameStr))))
            If RegXReturn.Count > 0 Then
                StartsAt = RegXReturn(0).FirstIndex     ' Recall that FirstIndex starts at position zero, not 1 !!!
            Else
                Exit Do
            End If
        Loop
        
        ' If a suffix is found, then grab the entire suffix
        If StartsAt > -1 Then
            Suffix = Mid(NameStr, StartsAt + 1)
            ' remove comma if applicable
            If Left(Suffix, 1) = "," Then Suffix = Mid(Suffix, 2)
            ' remove possible leading space
            Suffix = Trim(Suffix)
            ' adjust NameStr to remove suffixes
            NameStr = Left(NameStr, StartsAt)
        End If
        
        ' Ensure we have space delimiters for remaining NameStr
        NameStr = Replace(NameStr, ".", ". ")
        
        ' Remove extraneous spaces
        RegX.Pattern = " {2,}"
        NameStr = Trim(RegX.Replace(NameStr, " "))
        
        ' Create zero-based array with remaining "words" in the name
        NameArr = Split(NameStr, " ")
        
        ' First name is always assumed to be in position zero
        FName = NameArr(0)
        
        ' Depending on how many "words" are left and whether middle name is assumed to possibly be there
        ' (UseMiddle argument), grab middle/last names
        
        Select Case UBound(NameArr)
            Case 0
                'no middle or last names
            Case 1
                ' first name and last name
                LName = NameArr(1)
            Case Else
                ' potentially first, middle, and last names are present
                If UseMiddle Then
                    ' position 1 is assumed to be middle name, and positions 2 to N the last name
                    MName = NameArr(1)
                    ' remaining "words" are for last name
                    For Counter = 2 To UBound(NameArr)
                        LName = LName & " " & NameArr(Counter)
                    Next
                    ' drop leading space
                    LName = Trim(LName)
                Else
                    ' assume no middle name, and all remaining words are for the last name
                    For Counter = 1 To UBound(NameArr)
                        LName = LName & " " & NameArr(Counter)
                    Next
                    ' drop leading space
                    LName = Trim(LName)
                End If
        End Select
    
    Else
    
        ' NameStr is structured <Surname> <Suffix (optional)>, <Title (optional)> <First name> <Middle Name (optional)>
        
        ' Find position of last comma
        LastComma = InStrRev(NameStr, ",")
        
        If LastComma > 0 Then
            
            ' Part1 will be <Surname> <Suffix (optional)> block;
            ' Part2 is <Title (optional)> <First name> <Middle Name (optional)>
            Part1 = Trim(Left(NameStr, LastComma - 1))
            Part2 = Trim(Mid(NameStr, LastComma + 1))
        
            ' Look for suffixes.  Use Do...Loop to allow for compound suffixes, as in "Neumann, PhD, Esq., Alfred E."
            
            ' StartsAt indicates where the suffix(es) start in Part1.  Initialize to -1, indicating no suffix
            StartsAt = -1
            
            ' Set Pattern to look for suffix at end of Part1
            RegX.Pattern = "(, *| +)(" & Suffixes & ")\.?$"
            
            ' Evaluate Part1.  As long as a suffix is found in the portion evaluated, reset the StartsAt variable.
            ' When no more suffixes are found, terminate the loop
            Do
                Set RegXReturn = RegX.Execute(Left(Part1, IIf(StartsAt > -1, StartsAt, Len(Part1))))
                If RegXReturn.Count > 0 Then
                    StartsAt = RegXReturn(0).FirstIndex     ' Recall that FirstIndex starts at position zero, not 1 !!!
                Else
                    Exit Do
                End If
            Loop
            
            ' If a suffix is found, then grab the entire suffix
            If StartsAt > -1 Then
                Suffix = Mid(Part1, StartsAt + 1)
                ' remove comma if applicable
                If Left(Suffix, 1) = "," Then Suffix = Mid(Suffix, 2)
                ' remove possible leading space
                Suffix = Trim(Suffix)
                ' adjust Part1 to remove suffixes
                Part1 = Left(Part1, StartsAt)
            End If
            LName = Trim(Part1)
        
            ' Set Pattern to look for titles at beginning of Part2
            RegX.Pattern = "^(" & Titles & ")\.? +"
            
            ' Look for titles.  Use Do...Loop to allow for compound suffixes, as in "Dimmesdale, Rev. Mr. Arthur"
            Do
                Set RegXReturn = RegX.Execute(Mid(Part2, TitleLen + 1))
                If RegXReturn.Count > 0 Then
                    TitleLen = TitleLen + Len(RegXReturn(0))
                Else
                    Exit Do
                End If
            Loop
            
            ' Get Title
            Title = Trim(Left(Part2, TitleLen))
            
            ' Adjust Part2
            Part2 = Mid(Part2, TitleLen + 1)
        
            ' Ensure we have space delimiters for remaining Part2
            Part2 = Replace(Part2, ".", ". ")
            
            ' Remove extraneous spaces
            RegX.Pattern = " {2,}"
            Part2 = Trim(RegX.Replace(Part2, " "))
            
            ' Grab first/middle names from Part2
            If UseMiddle And InStr(1, Part2, " ") > 0 Then
                MName = Mid(Part2, InStrRev(Part2, " ") + 1)
                FName = Left(Part2, InStrRev(Part2, " ") - 1)
            Else
                FName = Part2
            End If
        End If
        
    End If
    
    ' determine function's return value
        
    With dic
        .Item("Title") = Title
        .Item("First") = FName
        .Item("Middle") = MName
        .Item("Last") = LName
        .Item("Suffix") = Suffix
    End With
    
    Set GetAllNameParts = dic
    
    ' destroy object variable
    
    Set RegXReturn = Nothing
    Set dic = Nothing
    
End Function
    
Private Function GenerateLists(ListType As String)
    
    Dim Titles As String
    Dim Suffixes As String
    
    ' In creating the master title and suffix lists, keep in mind that the strings will be passed in as part of a
    ' RegExp pattern, and so typical syntax rules for the VBScript implementation of RegExp will apply for things
    ' such as optional characters and escaping reserved characters.  For example:
    '
    '           M\.? ?D
    '
    ' matches M, then zero or one period, then zero or one space, then D.  Use the pipe character to delimit your
    ' entries
    
    ' If the lists get too long to keep using line continuators, then simply break them up into separate expressions:
    '
    ' Titles = 'Dr|Doctor|Mrs|Ms|Miss|Mr|Mister|Master|'
    ' Titles = Titles & "Reverend|Rev|Right Reverend|Right Rev|Most Reverend|
    ' Titles = Titles & "Most Rev|Honorable|Honourable"
    
    ' Populate master title list.  This can be expanded according to your needs.  There is no need to include a
    ' trailing period here, as the Pattern string built later on includes an optional period at the end.  In cases
    ' where a title may be shortened, list the longer version first.  For example, list Senator before Sen.
    
    Titles = "Dr|Doctor|Mrs|Ms|Miss|Mr|Mister|Master|Reverend|Rev|Right Reverend|Right Rev|Most Reverend|" & _
        "Most Rev|Honorable|Honourable|Hon|Monsignor|Msgr|Father|Fr|Bishop|Sister|Sr|Mother Superior|Mother|" & _
        "Senator|Sen|President|Pres|Vice President|V\.? ?P|Secretary|Sec|General|Gen|Lieutenant General|Lt\.? ?Gen|" & _
        "Major General|Maj\.? ?Gen|Brigadier General|Brig\.? ?Gen|Colonel|Col|Lieutenant Colonel|Lt\.? ?Col|Major|" & _
        "Maj|Sir|Dame|Lord|Lady|Judge|Professor|Prof"
    
    ' Populate master suffix list.  This can be expanded according to your needs.  There is no need to include a
    ' trailing period here, as the Pattern string built later on includes an optional period at the end.  In cases
    ' where a title may be shortened, list the longer version first.  For example, list Esquire before Esq.  Also,
    ' list III before II, and II before I
    
    Suffixes = "M\.? ?D|Ph\.? ?D|Esquire|Esq\.?|J\.? ?D|D\.? ?D|Jr|Sr|III|II|I|IV|X|IX|VIII|VII|VI|V|M\.? ?P|" & _
        "M\.? ?S\.? ?W|C\.? P\.? ?A|P\.? M\.? ?P|L\.? ?P\.? ?N|R\.? ?N|A\.? ?S\.? ?E|U\.? ?S\.? ?N|" & _
        "U\.? ?S\.? ?M\.? ?C|R\.? ?G\.? ?C\.? ?E|P\.? ?M\.? ?P|P\.? ?E|M\.? ?O\.? ?S|M\.? ?C\.? ?T\.? ?S|" & _
        "M\.? ?C\.? ?T|M\.? ?C\.? ?S\.? ?E|M\.? ?C\.? ?S\.? ?D\.? ?|M\.? ?C\.? ?S\.? ?A|M\.? ?C\.? ?P\.? ?D|" & _
        "M\.? ?C\.? ?M|M\.? ?C\.? ?L\.? ?T|M\.? ?C\.? ?I\.? ?T\.? ?P|M\.? ?C\.? ?D\.? ?S\.? ?T|" & _
        "M\.? ?C\.? ?D\.? ?B\.? ?A|M\.? ?C\.? ?B\.? ?M\.? ?S\.? ?S|M\.? ?C\.? ?B\.? ?M\.? ?S\.? ?P|" & _
        "M\.? ?C\.? ?A\.? ?S|M\.? ?C\.? ?A\.? ?D|M\.? ?C\.? ?A|I\.? ?T\.? ?I\.? ?L|C\.? ?R\.? ?P|C\.? ?N\.? ?E|" & _
        "C\.? ?N\.? ?A|C\.? ?I\.? ?S\.? ?S\.? ?P|C\.? ?C\.? ?V\.? ?P|C\.? ?C\.? ?S\.? ?P|C\.? ?C\.? ?N\.? ?P|" & _
        "C\.? ?C\.? ?I\.? ?E|C\.? ?A\.? ?P\.? ?M|S\.? ?J|O\.? ?F\.? ?M|C\.? ?N\.? ?D|M\.? ?B\.? ?A|M\.? ?S"
        
    If ListType = "Titles" Then
        GenerateLists = Titles
    Else
        GenerateLists = Suffixes
    End If
    
End Function

Open in new window

0
 
bromy2004Commented:
Thanks patrick. I did that from my BB so I might have missed something
Here is an updated on

Sub ReverNames()
Dim cel as range
Dim strSplit() as string
Dim strFirst as string
Dim strNew as string
Dim I as integer

For each cel in application.selection
Strsplit=split(cel.value," "_)
Strfirst=strsplit(lbound(strsplit))

For i=lbound(strsplit) to ubound(strsplit)
 If I<>lbound(strsplit) then
  Strsplit(i-1)=strsplit(I)
 End if
Next i

Redim preserve strsplit(lbound(strsplit),ubound(strsplit)-1)
Strnew=strfirst & join(strsplit," ")
Cel.value=strnew
Next cel

End sub

I looped through with I because I seem to remember you can't change the lowerbound on an array
0
 
camtzAuthor Commented:
You all must be programers because this is way over my head.  However, I HAVE SOME GREAT NEWS.  I got the formula to work just fine except for the middle initial.  I ran across some names with middle initials and the initial was the first thing to show up followed by the last name and finally the first name.  Patrick seems to have and answer for that so I will try to modify it so that the middle initial appears last.

Thank all of you so much for helping me out.  In worse case scenario I could manually move the initial to the end if I have to.  I hope I don't. Will let you know.
0
 
Ingeborg Hawighorst (Microsoft MVP / EE MVE)Microsoft MVP ExcelCommented:
Hello camtz,

If you prefer the formula and just need to cater for one or more middle initials to appear at the end, then try this formula with your names in column C. Formula starts in row 2, column does not matter. Copy down

=TRIM(MID(C2,FIND("^^",SUBSTITUTE(C2," ","^^",MAX(1,LEN(C2)-LEN(SUBSTITUTE(C2," ",""))))&"^^")+1,99)&" "&LEFT(C2,FIND("^^",SUBSTITUTE(C2," ","^^",MAX(1,LEN(C2)-LEN(SUBSTITUTE(C2," ",""))))&"^^")))

See the attached file for a working example with several names including one none or several middle names.

cheers, teylyn
Q-28740897-swap-first-and-last-n.xls
0
 
Patrick MatthewsCommented:
camtz,

Fortunately for you, we've done the programming for you :)

To use my suggestion, simply do this:

1) From Excel, hit Alt+F11 to get the VB Editor

2) From the VB Editor, select Insert|Module from the menu

3) Copy and paste the code I provided into that module

4) Go back to Excel, and enter the formula I provided, and copy it down as needed.  (If your data do not start in A2, then adjust that range reference

BTW, teylyn's updated formula will work just fine for middle initials.  Of course, just like my approach, it can run into difficulties if you have any "name parts" consisting of more than one word.  That contingency will *always* cause problems.

Patrick
0
 
Ingeborg Hawighorst (Microsoft MVP / EE MVE)Microsoft MVP ExcelCommented:
Patrick, I wonder if there will ever be a permanent solution for this. Probably not until they teach Excel regional differences for names. But with the world becoming a global village, even that won't help much.

pipe symbol | inserted to demarcate last name

John F | Kennedy
Mary Ann | Winters
Hilary | Rodham Clinton
Sabine | Leutheuser-Schnarrenberger (don't laugh, that's an actual German politician's name!)
Jan Herman | Van Veen
Cor | over de Vest
Maria Dolores | Valdez Murillo
Sue Ellen Rodham Van Veen

arrgghhh!


It's hard enough for human beings to decide where the last name starts. How can we ever teach Excel?

Thanks for acknowledging that my formula works at least for the simple cases, i.e. anything after the last space is treated the last name.

cheers, teylyn
0
 
bromy2004Commented:
For the experts,
Would my V2 macro work?
It would skip the step of inserting a blank column then deleting it.
0
 
Ingeborg Hawighorst (Microsoft MVP / EE MVE)Microsoft MVP ExcelCommented:
Bromy,

I'll never understand how ppl can write code on a BB. Shivers! :-)

I pasted your V2 code but got a red line for

Strsplit=split(cel.value," "_)

I changed that to

Strsplit=split(cel.value," ")

and used F8 to step through the code. It got a Subscript out of Range at

ReDim Preserve strSplit(LBound(strSplit), UBound(strSplit) - 1)

Since I am a formula Grrrl rather than a VBA hag, I have no clue what that means. Hope you'll have access to a real 'puter soon to check it out, so I can learn.

cheers, teylyn

0
 
Patrick MatthewsCommented:
teylyn,

I don't think a general solution will ever be possible.  There are some commercial programs that a really, really good job, but they can be pricey.

My code does a reasonable job, but will never be perfect.

Name parsing is an inherently difficult proposition, more difficult I think than most people imagine.  My article touches on that complexity, but entire books can be written on the subject :)

Patrick
0
 
bromy2004Commented:
Woops
That was supposed to be
ReDim Preserve strSplit(LBound(strSplit) to  UBound(strSplit) - 1)

It is a bit of a challenge to remember what's in VBA and VB.NET without the popups
0
 
Ingeborg Hawighorst (Microsoft MVP / EE MVE)Microsoft MVP ExcelCommented:
Sorry, Bromy, not much luck on the BB.

I replaced the line of code and it ran on

John Smith

to produce

JohnSmith

Next name was

John E Smith

which the code changed to

JohnE Smith

Next name was

John

on which the code bombed out with "Subscript out of Range"

Currently I feel my formula is doing a slightly better job. I have not tried Patrick's code, though, but I don't doubt for a second that it will work.

Cheers, teylyn


0
 
bromy2004Commented:
I think you're right teylyn.
in the interest of accuracy for any other ppl wanting a solution, i'll work on my macro when I get to a computer.
0
 
bromy2004Commented:
Strnew=strfirst & join(strsplit," ")
Should be

Strnew=join(strsplit," ") & " " & strfirst
0
 
bromy2004Commented:
Heya Experts,
Finally at my computer

Attached is a Macro and a Function, both doing the same thing

My understanding is that camtz wants Surname FirstName Middle1 Middle2

Teylyn's first solution
http:#a28740897
fails when there is a Leading space
Names in wrong order

Teylyn's Second formula
http:#a28861405
fails when there is a trailing space
Names in right order

I really like Patrick's article suggestion and formula (i voted yes)
http:#a28813438 but i think it's a bit too advanced to set up and understand for camtz
as well as the formula needing to be changed for multiple middle names.

My macro and function attached work perfectly with extra trailing and leading spaces.
The macro being able to loop through camtz's entire list.

I've attached an xls with all 4 functions, including my macro and Patrick's code as well
Sub SubReverseNames()
Dim cel As Range
Dim strSplit() As String
Dim strLast As String
Dim strNew As String
Dim i As Integer


For Each cel In Application.Selection
  If Not cel.Value = "" Then
    'Clean Trailing and Ending spaces
    cel.Value = Trim(cel.Value)
    
    'split name into parts (seperated by spaces)
    strSplit = Split(cel.Value, " ")
    
    'If there is only 1 name it will skip and go to next cell
    If Not LBound(strSplit) = UBound(strSplit) Then
      
      'Get First name
      strLast = strSplit(UBound(strSplit))
          
      'George Smith Smith becomes George Smith
      ReDim Preserve strSplit(LBound(strSplit) To UBound(strSplit) - 1)
    End If
    
    'New name = Other names
    strNew = Join(strSplit, " ")
    
    'add first name
    strNew = strLast & " " & strNew
  
  End If
  
  'Return new name
  cel.Value = Trim(strNew)
Next cel

End Sub
Function FuncReverseNames(ByVal Name As String) As String
Dim strSplit() As String
Dim strLast As String
Dim strNew As String
Dim i As Integer

If Not Name = "" Then
  'Clean Trailing and Ending spaces
  Name = Trim(Name)
  
  'split name into parts (seperated by spaces)
  strSplit = Split(Name, " ")
  
  'If there is only 1 name it will skip and go to next cell
  If Not LBound(strSplit) = UBound(strSplit) Then
    
    'Get First name
    strLast = strSplit(UBound(strSplit))
        
    'George Smith Smith becomes George Smith
    ReDim Preserve strSplit(LBound(strSplit) To UBound(strSplit) - 1)
  End If
  
  'New name = Other names
  strNew = Join(strSplit, " ")
  
  'add first name
  strNew = strLast & " " & strNew

End If
'Return new name
FuncReverseNames = Trim(strNew)
  
End Function

Open in new window

EE-Name-Replace.xls
0
 
Ingeborg Hawighorst (Microsoft MVP / EE MVE)Microsoft MVP ExcelCommented:
Thanks for spotting that trailing space error, Bromy.

Fixed with this version of the formula:

=TRIM(MID(TRIM(C2),FIND("^^",SUBSTITUTE(TRIM(C2)," ","^^",MAX(1,LEN(TRIM(C2))-LEN(SUBSTITUTE(TRIM(C2)," ",""))))&"^^")+1,99)&" "&LEFT(TRIM(C2),FIND("^^",SUBSTITUTE(TRIM(C2)," ","^^",MAX(1,LEN(TRIM(C2))-LEN(SUBSTITUTE(TRIM(C2)," ",""))))&"^^")))

Attached a sample with some names.

This now arrives at the same results as Bromy's UDFs, but does not require macros enabled.

cheers, teylyn
scratch.xls
0
 
camtzAuthor Commented:
Thank you all very nuch for all the work you put into this.  It is working just fine and it's going to save me many hours of work.  
0

Featured Post

Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

  • 9
  • 6
  • 5
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now