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 (http://www.ozgrid.com/forum/showthread.php?t=74919).

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 (http://uk.answers.yahoo.com/question/index?qid=20080416072117AAO9hdO)

[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)