使用后缀重新排序名称的各个部分

Question

I need help on vba code to reorder the parts of a name. Sometimes there is a suffix (Jr, Sr, I, II, III, IV), and that is the part I can't figure out. There is no list that I need to loop thru. The elements of the name could look like this: Johnson, Joseph Allen Jr
This code works for getting the last name moved to the end, but now I need to trim & move the suffix to the right after the last name.

Range("A1") = Trim(StrReverse(Split(StrReverse(Range("A1")), ",")(0)) & " " _
                    & StrReverse(Split(StrReverse(Range("A1")), ",")(1)))

Result:   Joseph Allen Jr    Johnson
Result Required:  Joseph Allen Johnson Jr

Thanks for any help!

Answer 1

So if your inputs are like Johnson, Joseph Allen Jr then you could set up an array/collection with the suffixes you want to check against. Then before you move the last name use

Dim i as Variant
Dim suffixArray as String()
Dim nameString as String
Dim suffixString as String
Dim arrayEntryLength as Long

suffixArray(0) = "Jr"
suffixArray(1) = "Sr"
suffixArray(2) = "I"
suffixArray(3) = "II"
...

for each i in suffixArray
    nameString = "Johnson, Joseph Allen Jr"    'or use Cells(1,"a").value
    arrayEntryLength = len(suffixArray(i))
    if Right(nameString, arrayEntryLength) = suffixArray(i) then
        suffixString = suffixArray(i)
        nameString = left(nameString, len(nameString)-arrayEntryLength)
    end if
next i

'move the last name of nameString

nameString = nameString & " " & suffixString

'rest of code

Answer 2

The full name is a unparsed string and manipulating "Suffix" as mentioned above by Chris H may be a suitable way. Here is Fullname content model in Outlook contact Item: https://docs.microsoft.com/en-us/office/vba/api/outlook.contactitem.fullname . Building an array of known suffixes will solve this in general. Watch out: the suffix may such as King Louis XVII, etc. is some historical context.