Split comma separated entries to new rows

Question

I currently have this data in a sheet

Col A   Col B
1       angry birds, gaming
2       nirvana,rock,band

What I want to do is split the comma separated entries in the second column and insert in new rows like below:

Col A   Col B
1   angry birds
1   gaming
2   nirvana
2   rock
2   band

I am sure this can be done with VBA but couldn't figure it out myself.

Are you trying to do this in-place or are you fine with using new sheet? — Sergio Tulentsev, Dec 19 '11 at 11:38
Refer the link http://stackoverflow.com/questions/471435/excel-macro-comma-separated-cells-to-rows — Kannan Suresh, Dec 19 '11 at 12:19
@KannanS the code(s) in that link aren't overly pretty - the accepted answer uses `Select` and `InStr` inside a range loop to recut, the 2nd is the best of them as it uses arrays but it concatenates to a very long string pre output, the third wont compile. Lastly none do exactly the required task here (which has the A columnn to deal with) — brettdj, Dec 19 '11 at 12:46

brettdj · Accepted Answer · 2014-01-15T02:02:46.190

You are better off using variant arrays rather than cell loops - they are much quicker code wise once the data sets are meaningful. Even thoug the code is longer :)

This sample below dumps to column C and D so that you can see the orginal data. Change [c1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y) to [a1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y) to dump over your original data

[Updated with regexp to remove any blanks after , ie ", band" becomes "band"]

Sub SliceNDice() 
Dim objRegex As Object 
Dim X 
Dim Y 
Dim lngRow As Long 
Dim lngCnt As Long 
Dim tempArr() As String 
Dim strArr 
Set objRegex = CreateObject("vbscript.regexp") 
objRegex.Pattern = "^\s+(.+?)$" 
 'Define the range to be analysed
X = Range([a1], Cells(Rows.Count, "b").End(xlUp)).Value2 
Redim Y(1 To 2, 1 To 1000) 
For lngRow = 1 To UBound(X, 1) 
     'Split each string by ","
    tempArr = Split(X(lngRow, 2), ",") 
    For Each strArr In tempArr 
        lngCnt = lngCnt + 1 
         'Add another 1000 records to resorted array every 1000 records
        If lngCnt Mod 1000 = 0 Then Redim Preserve Y(1 To 2, 1 To lngCnt + 1000) 
        Y(1, lngCnt) = X(lngRow, 1) 
        Y(2, lngCnt) = objRegex.Replace(strArr, "$1") 
    Next 
Next lngRow 
 'Dump the re-ordered range to columns C:D
[c1].Resize(lngCnt, 2).Value2 = Application.Transpose(Y) 
End Sub

enter image description here

+1 cool code. Good one man. If possible remove those spaces that comes after comma. Once again, good work man. — Kannan Suresh, Dec 19 '11 at 15:15
@kannans thx and good suggestion, as the asker hasn't replied on the query raised on the data layout I will add your suggested improvement — brettdj, Dec 19 '11 at 22:48
Just ran this on a very similar issue of my own. Worked flawlessly. Thanks! — lambertj, Mar 08 '18 at 17:19

score 6 · Answer 2 · answered Dec 19 '11 at 12:23

6

Takes your data in column A and puts the results in column C.

Sub SplitAll()
    Dim src As Range
    Dim result As Variant
    For Each src In Range("A:A").SpecialCells(xlCellTypeConstants)
        result = Split(src, ",")
        'last cell in column C
        With Cells(Rows.Count, 3).End(xlUp)
            Range(.Offset(1, 0), .Offset(1 + UBound(result, 1), 0)) = Application.WorksheetFunction.Transpose(result)
        End With
    Next src
End Sub

answered Dec 19 '11 at 12:23

iDevlop

24,841
11
90
149

Ooops, I just saw the link provided by Kannan S. Looks like I worked for nothing. Anyway my code is shorter :-)) – iDevlop Dec 19 '11 at 12:27
Yep - and your code only splits column A ..... but the data to be worked on was column B (with A as a marker) Its a two column output. :) – brettdj Dec 19 '11 at 12:38
At least that will be a nice small exercise for redGREENblue ;-) – iDevlop Dec 19 '11 at 12:56

Split comma separated entries to new rows

2 Answers2

Linked

Related