Separating names into rows using formulas

[jeffcoleky]

I have thousands of names I need to separate into rows using formulas. This will be a challenge because of the naming format:

I have it MOSTLY down but I'm stuck because my first names get put into the middle name column when there is no middle initial.

SAMPLE DATA:

A		B	C	D
Full Name	First	Middle	Last
SMITH BOB E	Bob	E	Smith
FRENCH PIERRE S	Pierre	S	French
CRICKET JIMMY		Jimmy	Cricket
GOLD POT OF	Pot	Of	Gold
LATER CHARLIE U	Charlie	U	Later

First Name Formula: =PROPER(IF(LEN(A2)-LEN(SUBSTITUTE(A2," ",""))=1,"",MID(A2,FIND(" ",A2,1)+1,FIND(MID(A2,FIND("~",SUBSTITUTE(A2," ","~",LEN(A2)-LEN(SUBSTITUTE(A2," ",""))))+1,255),A2,1)-2-FIND(" ",A2,1))))

MIDDLE NAME FORMULA: =PROPER(REPLACE(A2,1,SEARCH("^",SUBSTITUTE(A2," ","^",LEN(A2)-LEN(SUBSTITUTE(A2," ","")))),""))

LAST NAME FORMULA: =PROPER(LEFT(A2,SEARCH(" ",A2)-1))


YOUR HELP IS MUCH APPRECIATED!

 

[jeffcoleky]

Sub Name_Splitter()
    
    Dim rng As Range, cell As Range, Names As Variant, NameParts As Variant
    
    Set rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
    
    Application.ScreenUpdating = False
    
    rng.Offset(, 1).Resize(, 6).ClearContents
    
    For Each cell In rng
        If cell.Value <> "" Then
            Names = Split(Application.WorksheetFunction.Trim(cell.Value), " & ")
            
            ' Single name or 1st of Couple
            NameParts = Split(Names(0), " ")
            cell.Offset(, 1).Value = StrConv(NameParts(1), vbProperCase)
            If UBound(NameParts) = 2 Then cell.Offset(, 2).Value = StrConv(NameParts(2), vbProperCase)
            cell.Offset(, 3).Value = StrConv(NameParts(0), vbProperCase)
            
            ' 2nd name if Couple
            If UBound(Names) > 0 Then
                NameParts = Split(Names(1), " ")
                If UBound(NameParts) = 0 Then
                    ' Pat
                    cell.Offset(, 4).Value = StrConv(NameParts(0), vbProperCase)
                    cell.Offset(, 6).Value = cell.Offset(, 3).Value
                ElseIf UBound(NameParts) = 1 And Len(NameParts(1)) = 1 Then
                    ' Pat E
                    cell.Offset(, 4).Value = StrConv(NameParts(0), vbProperCase)
                    cell.Offset(, 5).Value = UCase(NameParts(1))
                    cell.Offset(, 6).Value = cell.Offset(, 3).Value
                Else
                    ' Jones Sarah  or  Jones Sarah A
                    cell.Offset(, 4).Value = StrConv(NameParts(1), vbProperCase)
                    If UBound(NameParts) = 2 Then cell.Offset(, 5).Value = StrConv(NameParts(2), vbProperCase)
                    cell.Offset(, 6).Value = StrConv(NameParts(0), vbProperCase)
                End If
            End If
        End If
    Next cell
    
    Application.ScreenUpdating = True

End Sub

IT WORKS! Thank you Jedi Master.

 

[jeffcoleky]

Is there a way to make it only do this to the selected cells?

For instance, if I wanted to highlight Cells D1043:D1094 containing the pre-split data, it would run the script on those cells and then apply the results of the macro to the rows on the right of these cells?

 

[AlphaFrog]

Change this...

Set rng = Range("A2", Range("A" & Rows.Count).End(xlUp))

To this...

Set rng = Selection.Resize(, 1)

The macro won't work on pre-split data though what ever that means. It only would work in the scenario you originally outlined.

 

[jeffcoleky]

Change this...

Set rng = Range("A2", Range("A" & Rows.Count).End(xlUp))

To this...

Set rng = Selection.Resize(, 1)

The macro won't work on pre-split data though what ever that means. It only would work in the scenario you originally outlined.

Making that change worked great.

By Pre-Split data, I meant the exact same data PRIOR to the macro being run.

 

[jeffcoleky]

Now, i know you're not being paid for this and you've already earned a million brownie points, but there exists another question I must ask, oh Excel Jedi Master.

Note the added Columns "H" & "I"

Excel Workbook
	A	B	C	D	E	F	G	H	I
1	Full Names	First1	Middle1	Last1	First2	Middle2	Last2	Name_Combined_First	Name_Combined_Last
2	SMITH BOB E	Bob	E	Smith				Bob	Smith
3	FRENCH PIERRE S	Pierre	S	French				Pierre	French
4	CRICKET JIMMY	Jimmy		Cricket				Jimmy	Cricket
5	GOLD POT OF	Pot	Of	Gold				Pot	Gold
6	LATER CHARLIE U	Charlie	U	Later				Charlie	Later
7	JEFFREYS RON & PAT	Ron		Jeffreys	Pat		Jeffreys	Ron & Pat	Jeffreys
8	JEFFREYS RON & PAT E	Ron		Jeffreys	Pat	E	Jeffreys	Ron & Pat	Jeffreys
9	BAKER BOB E & JONES SARAH	Bob	E	Baker	Sarah		Jones	Bob Baker & Sarah Jones
10	BAKER BOB E & JONES SARAH A	Bob	E	Baker	Sarah	A	Jones	Bob Baker & Sarah Jones
11	BAKER BOB E & JONES SARAH ASHLEY	Bob	E	Baker	Sarah	Ashley	Jones	Bob Baker & Sarah Jones
IMPORTED

Excel 2010

I wish to take the data from Columns B, D, & E and populate H & I.

It is pretty obvious what I'm wanting to do from the chart, but this is how I see it:

• If there is only one name, it gets transposed just as it is in "B and D" -> "H and I" (see Rows 2-6).
  
• If the names in columns "D and G" in the same row are identical, then put that last name into Column "I", then combine "B and E" and put it in column "H", with a "&" in between.
  
• If the names in columns D & G in the same row are DIFFERENT, then combine "B, D, & E, G" in into Column "H". The seperator would be an "&" as well.

Would this be a simple thing to add to the macro?

PS. If we could have the macro INSERT the needed columns to make room for the data it is about to paste that would also be great, but if it's not simple don't worry about it.

 

[jeffcoleky]

Did you give up on me Alphafrog? Maybe Yoda passed-away and I have passed my test.