Excel macro -Split comma separated entries to new rows

Question

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.

Hello and welcome to StackOverflow. Please take some time to read the help page, especially the sections named ["What topics can I ask about here?"](http://stackoverflow.com/help/on-topic) and ["What types of questions should I avoid asking?"](http://stackoverflow.com/help/dont-ask). And more importantly, please read [the Stack Overflow question checklist](http://meta.stackexchange.com/q/156810/204922). You might also want to learn about [MCVE](http://stackoverflow.com/help/mcve). And include the code you are trying to work through...so people can help. — Rdster, Dec 06 '16 at 20:08

score 5 · Accepted Answer · answered Dec 06 '16 at 23:31

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:

result:

This did do what I wanted exactly. Could you explain a bit on how it works? — Shravan Vijayaprasad, Dec 13 '16 at 15:28

score 1 · Answer 2 · answered Jun 22 '18 at 15:40

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

score 0 · Answer 3 · answered Dec 06 '16 at 21:41

This is not a polished solution, but I need to spend some time with the wife.

But still another way of thinking about it.

This code assumes that the sheet is called Sheet4 and the range that needs to be split is col C.

Dim lastrow As Integer
Dim i As Integer
Dim descriptions() As String

With Worksheets("Sheet4")
    lastrow = .Range("C1").End(xlDown).Row
    For i = lastrow To 2 Step -1
        If InStr(1, .Range("C" & i).Value, ",") <> 0 Then
            descriptions = Split(.Range("C" & i).Value, ",")
        End If
        For Each Item In descriptions
            .Range("C" & i).Value = Item
            .Rows(i).Copy
            .Rows(i).Insert
        Next Item
        .Rows(i).EntireRow.Delete

    Next i
End With

score 0 · Answer 4 · answered Dec 09 '16 at 16:00

This will do what you want.

Option Explicit

Const ANALYSIS_ROW As String = "C"
Const DATA_START_ROW As Long = 1

Sub ReplicateData()
    Dim iRow As Long
    Dim lastrow As Long
    Dim ws As Worksheet
    Dim iSplit() As String
    Dim iIndex As Long
    Dim iSize As Long

    'Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    With ThisWorkbook
        .Worksheets("Sheet1").Copy After:=.Worksheets("Sheet1")
        Set ws = ActiveSheet
    End With

    With ws
        lastrow = .Cells(.Rows.Count, ANALYSIS_ROW).End(xlUp).Row
    End With


    For iRow = lastrow To DATA_START_ROW Step -1
        iSplit = Split(ws.Cells(iRow, ANALYSIS_ROW).Value2, ",")
        iSize = UBound(iSplit) - LBound(iSplit) + 1
        If iSize = 1 Then GoTo Continue

        ws.Rows(iRow).Copy
        ws.Rows(iRow).Resize(iSize - 1).Insert
        For iIndex = LBound(iSplit) To UBound(iSplit)
            ws.Cells(iRow, ANALYSIS_ROW).Offset(iIndex).Value2 = iSplit(iIndex)
        Next iIndex
Continue:
    Next iRow

    Application.CutCopyMode = False
    Application.Calculation = xlCalculationAutomatic
    'Application.ScreenUpdating = True
End Sub

Excel macro -Split comma separated entries to new rows

4 Answers4

Linked

Related