Excel macro -Split comma separated entries to new rows [duplicate]

I currently have this data in a sheet

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

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

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

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


Solution 1:

variant using Scripting.Dictionary

Sub ttt()
    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
    Dim x&, cl As Range, rng As Range, k, s
    Set rng = Range([C1], Cells(Rows.Count, "C").End(xlUp))
    x = 1 'used as a key for dictionary and as row number for output
    For Each cl In rng
        For Each s In Split(cl.Value2, ",")
            dic.Add x, Cells(cl.Row, "A").Value2 & "|" & _
                        Cells(cl.Row, "B").Value2 & "|" & LTrim(s)
            x = x + 1
    Next s, cl
    For Each k In dic
        Range(Cells(k, "A"), Cells(k, "C")).Value2 = Split(dic(k), "|")
    Next k
End Sub

source:

enter image description here

result:

enter image description here

Solution 2:

If you have a substantial amount of data, you willfind working with arrays beneficial.

Sub Macro2()
    Dim i As Long, j As Long, rws As Long
    Dim inp As Variant, outp As Variant

    With Worksheets("sheet2")
        inp = .Range(.Cells(1, "A"), .Cells(.Rows.Count, "C").End(xlUp)).Value2

        For i = LBound(inp, 1) To UBound(inp, 1)
            rws = rws + UBound(Split(inp(i, 3), ",")) + 1
        Next i

        ReDim outp(1 To rws, 1 To 3)
        rws = 0

        For i = LBound(inp, 1) To UBound(inp, 1)
            For j = 0 To UBound(Split(inp(i, 3), ","))
                rws = rws + 1
                outp(rws, 1) = inp(i, 1)
                outp(rws, 2) = inp(i, 2)
                outp(rws, 3) = Trim(Split(inp(i, 3), ",")(j))
            Next j
        Next i

        .Cells(1, "A").Resize(UBound(outp, 1), UBound(outp, 2)) = outp

    End With
End Sub