Reorder List of Names with Capitalized Last Names

[olives]

I haven't been here in a long time, but I wanted sto see if someone can help.

What I want to do is very similar to a thread I saw on another forum.

The thread is called 'Swap Last Name & First Name' and it is here Swap Last Name & First Name.

I posted there but I'm waiting for a reply.

I want to do the same thing - change the order of the last name and first name - but with the added difficulties that last names are captitalized and there may be 2 last names and maybe a first name and a middle name, too. I've listed some examples below:


Original data:

DOE John
VAN GOGH Vincent
DA VINCI Leonardo
NADAL PARERA Rafael
JIMENEZ RODRIGUEZ Miguel Ángel


What I'd like to do is get the names in the following format:

John Doe
Vincent Van Gogh
Leonardo Da Vinci
Rafael Nadal Parera
Miguel Ángel Jimenez Rodriguez

I know the following function is supposed to take the original data and separate the capitalized last names into a separate cell, but I'd like to just have a continuous name in the order First Name - Midde Name - Last Name - 2nd Last Name. Thanks!

Sub FixAddresses() 

RowNum = 1 
Do Until Cells(RowNum, 1) = "" 
OldText = Cells(RowNum, 1).Value 
WordLen = Len(OldText) 
For i = 8 To WordLen 
If (IsNumeric(Mid(OldText, i, 1)) Or _ 
(Mid(OldText, i, 1) = " ") Or _ 
(Mid(OldText, i, 1) = ",") Or _ 
(Mid(OldText, i, 1) = UCase(Mid(OldText, i, 1)))) Then 
EndChar = i 
Else 
Exit For 
End If 
Next 
NewText = Mid(OldText, 8, EndChar - 8) 
Cells(RowNum, 2).Value = NewText 
RowNum = RowNum + 1 
Loop 

End Sub

I found that function here:

Excel formula to extract only upper case text from a cell? - Yahoo UK & Ireland Answers

[Admin]

Hi

Put this code in a standard module.

Option Explicit

Function SWAPNAMES(InputName, Optional Delim As String = " ") As String
    
    Dim x, i As Long, n As Long
    
    If TypeName(InputName) = "Range" Then InputName = InputName.Value2
    x = Split(InputName, Delim)
    n = UBound(x)
    Select Case n
        Case Is >= 3
            For i = 2 To n
                SWAPNAMES = SWAPNAMES & String(1, 32) & StrConv(Trim(x(i)), vbProperCase)
            Next
            SWAPNAMES = Trim(SWAPNAMES & String(1, 32) & StrConv(Trim(x(0)), vbProperCase) & String(1, 32) & StrConv(Trim(x(1)), vbProperCase))
        Case Else
            SWAPNAMES = StrConv(Trim(x(n)), vbProperCase)
            For i = 0 To n - 1
                SWAPNAMES = SWAPNAMES & String(1, 32) & StrConv(Trim(x(i)), vbProperCase)
            Next
    End Select
    
End Function

and try

=SWAPNAMES(A1)