Split Names In One Cell to Multiple Columns

[azzurri13]

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

 

[Rick Rothstein]

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.

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

Your code is considerably slower than the code I posted. In a test of 10,000 rows of varying amounts of multiple names per cell, your code took about 38 seconds to execute whereas the code I posted clocked in at about 0.2 seconds.

 

[VBA Geek]

How could I run this on a whole column?

Thanks

[color=darkblue]Sub[/color] SplitNames()
[color=darkblue]Dim[/color] V, X [color=darkblue]As[/color] [color=darkblue]Long[/color]
V = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value


[color=darkblue]For[/color] X = [color=darkblue]LBound[/color](V, 1) [color=darkblue]To[/color] [color=darkblue]UBound[/color](V, 1)
    V(X, 1) = ConvertName(V(X, 1))
[color=darkblue]Next[/color] X


[color=darkblue]With[/color] Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    .Value = V
    .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]With[/color]


[color=darkblue]End[/color] [color=darkblue]Sub[/color]


[color=darkblue]Function[/color] ConvertName(RawNames) [color=darkblue]As[/color] [color=darkblue]String[/color]
[color=darkblue]Dim[/color] X [color=darkblue]As[/color] [color=darkblue]Long[/color], Y [color=darkblue]As[/color] Long


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]


ConvertName = Replace(RawNames, " ", vbNullString)
[color=darkblue]End[/color] [color=darkblue]Function[/color]

 

[JoeMo]

Your code is considerably slower than the code I posted. In a test of 10,000 rows of varying amounts of multiple names per cell, your code took about 38 seconds to execute whereas the code I posted clocked in at about 0.2 seconds.

Wasn't suggesting that it was an improvement on what you posted Rick, but I am surprised it's that much slower .

 

[JoeMo]

Your code is considerably slower than the code I posted. In a test of 10,000 rows of varying amounts of multiple names per cell, your code took about 38 seconds to execute whereas the code I posted clocked in at about 0.2 seconds.

Seems I wasted a lot of time auto-fitting column width cell by cell. This version, is considerably faster, but still not as fast as what you posted Rick.

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
Application.ScreenUpdating = False
For Each C In Selection
    V = Split(Replace(C.Value, " ", ""), ",")
    For i = LBound(V) To UBound(V) - 1 Step 2
        With C.Offset(0, ct)
                .Value = V(i) & "," & V(i + 1)
                ct = ct + 1
        End With
    Next i
    ct = 0
    Erase V
Next C
ActiveSheet.UsedRange.Columns.AutoFit
Application.ScreenUpdating = True
 End Sub

 

[Rick Rothstein]

Wasn't suggesting that it was an improvement on what you posted Rick, but I am surprised it's that much slower .

Actually, the time difference may be worse... I just repeated testing your code and now I am consistently getting between 81 and 83 seconds to complete the parsing of those 10,000 cells (perhaps I did not have all the cells selected originally?)(or maybe it is dependent on other processed being carried out by the computer in the background?). My code came in at 0.19 seconds this time. If you want to try the test on your own computer, what I did was put the following in cells A1:A5...

one, two
one, two, three, four
one, two, three, four, five, six
one, two, three, four, five, six, seven, eight
one, two, three, four, five, six, seven, eight, nine, ten

and then selected those five cells and copied it down to cell A10000. I then used...

Debug.Print Timer

at the beginning and end of each macro and performed the subtraction to get execution times. I would be interested to know the results when this test is performed on your computer if you are so inclined to test them.

 

[JoeMo]

Actually, the time difference may be worse... I just repeated testing your code and now I am consistently getting between 81 and 83 seconds to complete the parsing of those 10,000 cells (perhaps I did not have all the cells selected originally?)(or maybe it is dependent on other processed being carried out by the computer in the background?). My code came in at 0.19 seconds this time. If you want to try the test on your own computer, what I did was put the following in cells A1:A5...

one, two
one, two, three, four
one, two, three, four, five, six
one, two, three, four, five, six, seven, eight
one, two, three, four, five, six, seven, eight, nine, ten

and then selected those five cells and copied it down to cell A10000. I then used...

Debug.Print Timer

at the beginning and end of each macro and performed the subtraction to get execution times. I would be interested to know the results when this test is performed on your computer if you are so inclined to test them.

Did you see my post #14?

 

[Rick Rothstein]

Did you see my post #14?

I hadn't until just now. I saw the AutoFit and took it out when I did my tests (I had meant to mention that). It sounds like your computer may be faster than mine if you got a considerable speed up when you removed it.

 

[JoeMo]

I hadn't until just now. I saw the AutoFit and took it out when I did my tests (I had meant to mention that). It sounds like your computer may be faster than mine if you got a considerable speed up when you removed it.

I got approximately an order of magnitude execution time reduction (32 seconds --> 3.7 seconds) on the older of my two computers (7 years old) with 10,000 cells each containing the same four names (Last1,First1, ....., Last4, First4).

 

[Rick Rothstein]

I got approximately an order of magnitude execution time reduction (32 seconds --> 3.7 seconds) on the older of my two computers (7 years old) with 10,000 cells each containing the same four names (Last1,First1, ....., Last4, First4).

My computer is a couple of years newer than your... I wonder what's up with my computer that your code is taking so much longer to execute on it?

 

[JoeMo]

My computer is a couple of years newer than your... I wonder what's up with my computer that your code is taking so much longer to execute on it?

The computer I ran the test on uses an Intel T9300 Dual Core processor @ 2.5GHz.