Reorder parts of a name with a suffix - excel

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://learn.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.