Update User.Name with suffix when neccessary

[Livin404]

Greetings, I have a VBA which works "nearly" perfect. However there are occasions, on certain names it only displays the surname. For example the official username is: " WHITESIDE, SHERIDAN U A1C IATA AMC 437 ERA/TROP" with the my current VBA will give me "UPDATED BY: WHITESIDE" What I hope to get is UPDATED BY: A1C WHITESIDE. Some of the names work fine but others it just leaves the surname. Another example may have a username listed as "WHITESIDE, SHERIDAN U JR TSgt USAF IATA 437 APS/TROP." where I hope it will yield UPDATED BY: TSGT WHITESIDE. Please note for the suffix it would be along the lines of JR, SR, III, IV etc.

My current VBA is:

Sub find_last_plus_3()
Dim LastRow As Long, WorkName As String, Title As String, x As Variant

    LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    WorkName = Replace(Application.UserName, "GS-05", "MR")
    Title = ""
        For Each x In Array("MR ", "SrA ", "SSgt ", "A1C ", "TSgt ", "Amn ")
        If InStr(WorkName, x) > 0 Then
            Title = x
            Exit For
        End If
    Next x
    Range("A" & LastRow + 3).Value = "UPDATED BY: " & UCase(Title) & UCase(Split(WorkName, ",")(0))
      End Sub

 

[Livin404]

Greetings, I have a VBA which works "nearly" perfect. However there are occasions, on certain names it only displays the surname. For example the official username is: " WHITESIDE, SHERIDAN U A1C IATA AMC 437 ERA/TROP" with the my current VBA will give me "UPDATED BY: WHITESIDE" What I hope to get is UPDATED BY: A1C WHITESIDE. Some of the names work fine but others it just leaves the surname. Another example may have a username listed as "WHITESIDE, SHERIDAN U JR TSgt USAF IATA 437 APS/TROP." where I hope it will yield UPDATED BY: TSGT WHITESIDE. Please note for the suffix it would be along the lines of JR, SR, III, IV etc.

My current VBA is:

Sub find_last_plus_3()
Dim LastRow As Long, WorkName As String, Title As String, x As Variant

    LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    WorkName = Replace(Application.UserName, "GS-05", "MR")
    Title = ""
        For Each x In Array("MR ", "SrA ", "SSgt ", "A1C ", "TSgt ", "Amn ")
        If InStr(WorkName, x) > 0 Then
            Title = x
            Exit For
        End If
    Next x
    Range("A" & LastRow + 3).Value = "UPDATED BY: " & UCase(Title) & UCase(Split(WorkName, ",")(0))
      End Sub

There was a small adjustment, and everything seems to be working properly now. Thank you,

Sub find_last_plus_3()
Dim LastRow As Long
Dim wName As String, wSurame As String, Title As String
Dim x As Variant
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
 
wName = Replace(Application.UserName, "GS-05", "MR")
wSurname = UCase(Split(wName, ",")(0))

For Each x In Array("MR ", "SrA ", "SSgt ", "A1C ", "TSgt ", "Amn ")
    If InStr(wName, x) > 0 Then
        Title = UCase(x)
        Exit For
    End If
Next x
Range("A" & LastRow + 3).Value = "UPDATED BY: " & Title & wSurname
End Sub