Split Names In One Cell to Multiple Columns

A

azzurri13

New Member
Joined
Mar 29, 2015
Messages
5
I have an output that puts multiple names into one cell. The names are in the format "LASTNAME, FIRSTNAME, LASTNAME2, FIRSTNAME2...)

I need to split the names up and with first and last name separated by a comma, I can't use the delimiter as a comma.

How can I approach this? Any help is appreciated, thanks
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Sort by date Sort by votes
Is there a "carriage return" between names? Are there names with a middle initial or a suffix (Jr, Sr, ..)?
 
Upvote 0
Assuming your names are in Column A starting at Row 1 (the red highlighted text sets this location), give this macro a try...
Code: 
Sub SplitFirstLastNamesOutIntoSeparateCells()
  Dim R As Long, C As Long, S As Long, MaxNames As Long
  Dim Rng As Range, Data As Variant, FLnames() As String
  Set Rng = Range("[B][COLOR="#FF0000"]A1[/COLOR][/B]", Cells(Rows.Count, "[B][COLOR="#FF0000"]A[/COLOR][/B]").End(xlUp))
  MaxNames = Evaluate(Replace("MAX(0+(LEN(@)-LEN(SUBSTITUTE(@,"", "","""")))/2)", "@", Rng.Address))
  Data = Rng.Resize(, MaxNames)
  For R = 1 To UBound(Data)
    S = 0
    Data(R, 1) = Replace(Data(R, 1), ", ", ",")
    For C = 1 To Len(Data(R, 1))
      If Mid(Data(R, 1), C, 1) = "," Then
        S = S + 1
        If S Mod 2 = 0 Then Mid(Data(R, 1), C) = Chr(1)
      End If
    Next
    FLnames = Split(Data(R, 1) & Chr(1), Chr(1))
    For C = 1 To MaxNames
      If C <= UBound(FLnames) Then
        Data(R, C) = FLnames(C - 1)
      Else
        Data(R, C) = ""
      End If
    Next
  Next
  Rng.Resize(, MaxNames) = Data
End Sub
 
Upvote 0
i must be oversimplifying the issue but i think this should work too

Code: 
[color=darkblue]Sub[/color] SplitNames()
[color=darkblue]Dim[/color] X [color=darkblue]As[/color] [color=darkblue]Long[/color], RawNames [color=darkblue]As[/color] [color=darkblue]String[/color], Y [color=darkblue]As[/color] [color=darkblue]Long[/color]


RawNames = [a1].Value


X = InStr(1, RawNames, ", ", vbBinaryCompare)
Y = 1


[color=darkblue]Do[/color] [color=darkblue]Until[/color] X = 0
    [color=darkblue]If[/color] Y Mod 2 = 0 [color=darkblue]Then[/color] Mid(RawNames, X, 1) = "@"
    X = InStr(X + 1, RawNames, ", ", vbBinaryCompare)
    Y = Y + 1
[color=darkblue]Loop[/color]


[a1] = Replace(RawNames, " ", vbNullString)
Range("A1").TextToColumns , xlDelimited, xlTextQualifierNone, [color=darkblue]False[/color], [color=darkblue]False[/color], [color=darkblue]False[/color], False, False, [color=darkblue]True[/color], "@"
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 
Upvote 0
Rick Rothstein said:
Assuming your names are in Column A starting at Row 1 (the red highlighted text sets this location), give this macro a try...
Code: 
Sub SplitFirstLastNamesOutIntoSeparateCells()
  Dim R As Long, C As Long, S As Long, MaxNames As Long
  Dim Rng As Range, Data As Variant, FLnames() As String
  Set Rng = Range("[B][COLOR=#FF0000]A1[/COLOR][/B]", Cells(Rows.Count, "[B][COLOR=#FF0000]A[/COLOR][/B]").End(xlUp))
  MaxNames = Evaluate(Replace("MAX(0+(LEN(@)-LEN(SUBSTITUTE(@,"", "","""")))/2)", "@", Rng.Address))
  Data = Rng.Resize(, MaxNames)
  For R = 1 To UBound(Data)
    S = 0
    Data(R, 1) = Replace(Data(R, 1), ", ", ",")
    For C = 1 To Len(Data(R, 1))
      If Mid(Data(R, 1), C, 1) = "," Then
        S = S + 1
        If S Mod 2 = 0 Then Mid(Data(R, 1), C) = Chr(1)
      End If
    Next
    FLnames = Split(Data(R, 1) & Chr(1), Chr(1))
    For C = 1 To MaxNames
      If C <= UBound(FLnames) Then
        Data(R, C) = FLnames(C - 1)
      Else
        Data(R, C) = ""
      End If
    Next
  Next
  Rng.Resize(, MaxNames) = Data
End Sub
Click to expand...

VBA Geek said:
i must be oversimplifying the issue but i think this should work too

Code: 
[COLOR=darkblue]Sub[/COLOR] SplitNames()
[COLOR=darkblue]Dim[/COLOR] X [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], RawNames [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], Y [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]


RawNames = [a1].Value


X = InStr(1, RawNames, ", ", vbBinaryCompare)
Y = 1


[COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]Until[/COLOR] X = 0
    [COLOR=darkblue]If[/COLOR] Y Mod 2 = 0 [COLOR=darkblue]Then[/COLOR] Mid(RawNames, X, 1) = "@"
    X = InStr(X + 1, RawNames, ", ", vbBinaryCompare)
    Y = Y + 1
[COLOR=darkblue]Loop[/COLOR]


[a1] = Replace(RawNames, " ", vbNullString)
Range("A1").TextToColumns , xlDelimited, xlTextQualifierNone, [COLOR=darkblue]False[/COLOR], [COLOR=darkblue]False[/COLOR], [COLOR=darkblue]False[/COLOR], False, False, [COLOR=darkblue]True[/COLOR], "@"
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
Click to expand...


Thank you! These both worked well!
 
Upvote 0
VBA Geek said:
i must be oversimplifying the issue but i think this should work too

Code: 
[COLOR=darkblue]Sub[/COLOR] SplitNames()
[COLOR=darkblue]Dim[/COLOR] X [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], RawNames [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR], Y [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]


RawNames = [a1].Value


X = InStr(1, RawNames, ", ", vbBinaryCompare)
Y = 1


[COLOR=darkblue]Do[/COLOR] [COLOR=darkblue]Until[/COLOR] X = 0
    [COLOR=darkblue]If[/COLOR] Y Mod 2 = 0 [COLOR=darkblue]Then[/COLOR] Mid(RawNames, X, 1) = "@"
    X = InStr(X + 1, RawNames, ", ", vbBinaryCompare)
    Y = Y + 1
[COLOR=darkblue]Loop[/COLOR]


[a1] = Replace(RawNames, " ", vbNullString)
Range("A1").TextToColumns , xlDelimited, xlTextQualifierNone, [COLOR=darkblue]False[/COLOR], [COLOR=darkblue]False[/COLOR], [COLOR=darkblue]False[/COLOR], False, False, [COLOR=darkblue]True[/COLOR], "@"
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
Click to expand...

How could I run this on a whole column?

Thanks
 
Upvote 0
For the record, here's another macro I wrote last night while waiting for the response to Post #2. Just now gotten to that response.
Code: 
Sub SplitNamesToColumns()
'Select all the cells with multiple names in them, then run this macro
Dim C As Range, V As Variant, ct As Long
For Each C In Selection
    V = Split(Replace(C.Value, " ", ""), ",")
    Application.ScreenUpdating = False
    For i = LBound(V) To UBound(V) - 1 Step 2
        With C.Offset(0, ct)
                .Value = V(i) & "," & V(i + 1)
                .EntireColumn.AutoFit
                ct = ct + 1
        End With
    Next i
    ct = 0
    Erase V
Next C
Application.ScreenUpdating = True
 End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
VBA Split semicolon and comma separated values into new rows
Replies
9
Views
596
Adalinda
A
M
  • Question Question
How to split a full name in 1 column into 2 columns (C1 - First name, C2 - Last name (*but here's the tricky - what if there's a middle initial?
Replies
6
Views
318
Mavericx
M
S
  • Solved
Excel Split Full Name
Replies
3
Views
275
alansidman
A
A
  • Solved
Split First Name & Last Name If Last Name Exists
Replies
5
Views
249
Peter_SSs
Peter_SSs
J
  • Question Question
Split worksheets into separate excels AND only save those cells with data in them.
Replies
4
Views
303
mumps
mumps

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top