Rearrange names with VBA Macro

[Joshuabrico]

Good Afternoon,

I have a spreadsheet with names in column b (Lastname, Firstname or Lastname, Firstname Middlename or Lastname, generational suffix Firstname or Lastname, Firstname MiddleInitial ) I am needing to create a VBA code to rearrange the names and remove everything except for Lastname, Firstname.
I could find where I can filp lastname and firstname but if there is a middlename it does not work. Any help would be greatly appreciated. I was looking for VBA to link it to a form control button so that the user can copy and past the list to Column B and then click button to update. Since it is not a static list figured that would be the easiest way to change it within the same cell.

Thank you,

 

[Michael M]

CAn you popst a sample of your data, with an expected outcome.
You can either paste here, or upload to dropbox then post a link to that file back here.

 

[Joshuabrico]

Looking to make column

B to reflect Last, First only and change the others appropriately.

 

[Joshuabrico]

https://ibb.co/kRgq70

 

[Michael M]

We need a before AND after sample ??

 

[Joshuabrico]

Before Sample

https://ibb.co/mcE9Zf


After Sample

https://ibb.co/imacLL

 

[TotallyConfused]

Hello Joshuabrico

This has been an interesting and challenging project for me. I hope this is what you want. The only change you may need to make is in the first line. If your CodeName is NOT ‘Sheet1’ then change the word ‘Sheet1’ to whatever yours is. It will be ‘Sheet??’

Sub FormatNames()
   Dim ws1 As Worksheet: Set ws1 = Sheet1   'Change SHEET1 to your Excel sheet CodeName
   Dim Cel As Long
   Dim DataRows As Long
   Dim LoopCtr As Long
   Dim ArrNames() As String
With ws1
   DataRows = .Cells(Rows.Count, 2).End(xlUp).Offset(-1, 2).Row
Cel = 0
For LoopCtr = 2 To DataRows + 1
    ArrNames() = Split(.Range("B" & LoopCtr))
         For Cel = LBound(ArrNames()) To UBound(ArrNames())
             If (Right(ArrNames(1), 1) = ".") Then
                  ArrNames(1) = ArrNames(2)
             End If
                 .Range("B" & LoopCtr) = ArrNames(0) & " " & ArrNames(1)
          Next Cel
Next LoopCtr
End With
End Sub

TotallyConfused

 

[Michael M]

This function will cover most, but others like, "Snr","Dr", "Mr", etc could be added
Function modified from Chris Neilsen

Function TW(str As String) As String
    Dim i As Long
    str = Application.WorksheetFunction.Trim(str)
    str = Replace(str, " Jr", "")
    i = InStr(str, " ")
    If i > 0 Then
        i = InStr(i + 1, str, " ")
        If i > 0 Then
            str = Left$(str, i - 1)
        End If
    End If
    TW = str
End Function

Excel 2007
	A	B
1
2	inks, Mickie R.	inks, Mickie
3	Linbeck, Thomas J.	Linbeck, Thomas
4	Flores Jr, Feliciano C.	Flores, Feliciano
5	Bubel, Audrey	Bubel, Audrey
6
Sheet1

Cell Formulas
Range	Formula
B2	=TW(A2)
B3	=TW(A3)
B4	=TW(A4)
B5	=TW(A5)

 

[Joshuabrico]

TotallyConfused! Amazing.. your right it was a challenge for my skill level but you blew it our of the Park! thank you it works perfectly.

Micheal M, Thank you for your help and assistance it is greatly appreciated.

Respectfully,

Man with a smaller headache.

 

[TotallyConfused]

Hello Joshuabrico

You’re very welcome! Thank you for letting me know that what I had put together, worked for you. I’m glad I was able to help.

I’m fairly new to Excel and especially VBA, so I wasn’t kidding when I said your project posed a challenge to me. But that was good because it gave me a chance to do a couple of things I’ve never done before. In the process, I learned a lot.

I had to smile when I read the way you signed your note. It’s nice to know that because of my efforts, you now have a smaller headache. I never realized I was such a good doctor.

TotallyConfused