Reorder List of Names with Capitalized Last Names

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! :)

Code:

---

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

Hi

Put this code in a standard module.

Code:

---

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)