Alter Application.Username

[Livin404]

Greetings I have the following VBA which I can get the following results. Ranks and etc. are arbitrary. Which I get from: I would like to adjust the username, to make it more concise.

Sub find_last_plus_3()
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & LastRow + 3).Value = "UPDATED BY:" & " " & Application.UserName
End Sub

REVIEWED BY: WHITESIDE, SHERIDAN U ESQ-07 ERAU UAA 437 CHS/IATA
REVIEWED BY: WHITESIDE, SHERIDAN U CAPT ERAU UAA 437 CHS/IATA
REVIEWED BY: WHITESIDE, SHERIDAN U MAJ ERAU UAA 437 CHS/IATA

If at all possible I would like the end result to be.
UPDATED BY: MR WHITESIDE
UPDATED BY: CAPT WHITESIDE
UPDATED BY: MAJ WHITESIDE

I just would like to keep the surname drop everything else, but move that block of letters ESQ-07 and change it to a MR (no period). Most important there are only two in the organization that have this title. The rest will have a Rank it will be either 3 or 4 letters; for example, CAPT or MAJ. Any assistance would be great. Thank you

 

[Eric W]

I assume Sheridan U is the first name, middle initial? Will everyone have an initial? It might be easier to look for a list of the possible titles. Try:

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, "ESQ-07", "MR")
    Title = ""
    For Each x In Array("MR ", "CAPT ", "MAJ ", "GEN ", "PVT ")
        If InStr(WorkName, x) > 0 Then
            Title = x
            Exit For
        End If
    Next x
    Range("A" & LastRow + 3).Value = "UPDATED BY: " & Title & Split(WorkName, ",")(0)
End Sub

Although this could also have issues if you have a name that contains one of those titles, like
GENERO, HOLLY PVT

 

[Livin404]

That was absolutely perfect. It seems to be exactly what I was after. Thank you so much!

 

[Eric W]

Happy to help! Thanks for the feedback.