Change "Last name, first initial" to first name last name in sentences

[kmprice710]

I have Office Professional Plus 2019.

How do I fix this?

I have a column of cells with phrases like

"Adams, a went to the bathroom"
"Smith, d. lifted weights"
"Jones, maxwell ate dinner"
"The store would not serve Williams, t.j."
The shoe did not fit Thompson, f."
"Stuart, d and Pyle, Gerhard did not like Velma, uly"

The info is presented as "Last name, first name" or "Last name, first initial" or "Last name, first initial with a period" or "Last Name, first two initials" or "Last Name, first two initials with periods" with the first name or first initial in lower case.
The name can appear at the beginning, in the middle or at the end of the cell.

I want to change the cells to:

"A Adams went to the bathroom"
"D. Smith lifted weights"
"Maxwell Jones ate dinner"
"The store would not serve T.J. Williams"
"The shoe did not fit F. Thompson"
"D Stuart and Gerhard Pyle did not like Uly Velma"

I don't need end-of-sentence punctuation.

How do I do it?

 

[rlv01]

One way is to use VBA.

Book1
	A	B
1	Text	Processed Text
2	Adams, a went to the bathroom	A Adams went to the bathroom
3	Smith, d. lifted weights	D. Smith lifted weights
4	Jones, maxwell ate dinner	Maxwell Jones ate dinner
5	The store would not serve Williams, t.j.	The store would not serve T.J. Williams
6	The shoe did not fit Thompson, f.	The shoe did not fit F. Thompson
7	Stuart, d and Pyle, Gerhard did not like Velma, uly	D Stuart and Gerhard Pyle did not like Uly Velma
Sheet1

Sub DoSomething()
    Dim WS As Worksheet
    Dim rngColData As Range
    Dim R As Range
    Dim I As Long
    Dim S As String, Txt As String
    Dim SA As Variant

    Set WS = ActiveSheet

    With WS
        Set rngColData = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))    'range to last cell in column w/data
    End With

    For Each R In rngColData
        S = Replace(R.Value, ", ", ",")
        SA = Split(S, " ")
        Txt = ""
        For I = 0 To UBound(SA)
            If InStr(SA(I), ",") > 0 Then
                Txt = Txt & Application.Proper(Split(SA(I), ",")(1)) & " " & Split(SA(I), ",")(0) & " "
            Else
                Txt = Txt & SA(I) & " "
            End If
        Next I
        R.Offset(0, 1).Value = Trim(Txt)
    Next R
End Sub

 

[Peter_SSs]

I have Office Professional Plus 2019.

In that case do you need to amend your account details?

Another option is you could test this user-defined function.

Function FixNames(S As String) As String
  Dim RX As Object, M As Object
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  RX.Pattern = "(\b[A-Z][^ \,]+)(\, *)([^ ]+)"
  For Each M In RX.Execute(S)
    S = Replace(S, M, Application.Proper(M))
  Next M
  FixNames = RX.Replace(S, "$3 $1")
End Function

kmprice710.xlsm
	A	B
1	Adams, a went to the bathroom	A Adams went to the bathroom
2	Smith, d. lifted weights	D. Smith lifted weights
3	Jones, maxwell ate dinner	Maxwell Jones ate dinner
4	The store would not serve Williams, t.j.	The store would not serve T.J. Williams
5	The shoe did not fit Thompson, f.	The shoe did not fit F. Thompson
6	Stuart, d and Pyle, Gerhard did not like Velma, uly	D Stuart and Gerhard Pyle did not like Uly Velma
7
8	No names here	No names here
Sheet1

Cell Formulas
Range	Formula
B1:B8	B1	=FixNames(A1)