Expand Table with Delimited Column

Question

I see this question a lot, so I'm creating this question and answer so I (and other contributors) can just point to it in the future.

Let's say we have a situation where there is a table that looks like this:

Category    Items
Fruit       Apple,Orange
Vegetable   Carrot,Potato

And we want to turn it into a table that looks like this instead:

Category    Items
Fruit       Apple
Fruit       Orange
Vegetable   Carrot
Vegetable   Potato

In this example, we want to expand the table so that each item gets its own row, instead of being on the same row per category in a delimited column. How can we accomplish this using Excel VBA?

Answer 1

This code will accomplish the task. It is also customizable so that you can enter your table area, delimited column, and delimiter so that it can apply to most situations. The defaults are for the example described in the question.

Sub SplitDelimColToConvertTable()
'Created by TigerAvatar on Jan 23 2018
'Converts a table that contains a column with delimited information
'    into a table where the delimited column has been split so that
'    each item is on its own row
'Example:
'    Fruit        Apple,Orange
'    Vegetable    Carrot,Potato
'Becomes
'    Fruit        Apple
'    Fruit        Orange
'    Vegetable    Carrot
'    Vegetable    Potato

    Const ColStart As String = "A"  'Column where your table to convert starts
    Const ColFinal As String = "B"  'Column where your table to convert ends
    Const ColDelim As String = "B"  'Column containing the delimited data (does not have to be the same as ColFinal)
    Const RowStart As String = 2    'Row where your table to convert starts; do NOT use the header row (if any)
    Const Delimiter As String = "," 'The delimiter that will be split on

    Dim ws As Worksheet
    Dim Results() As Variant
    Dim Data As Variant
    Dim Part As Variant
    Dim ColDelimAddr As String
    Dim ColDelimNum As Long
    Dim iData As Long
    Dim iResults As Long
    Dim j As Long

    Set ws = ActiveWorkbook.Sheets("sheet1")
    With ws.Range(ColStart & RowStart, ws.Cells(ws.Rows.Count, ColStart).End(xlUp))
        ColDelimNum = Columns(ColDelim).Column - Columns(ColStart).Column + 1
        ColDelimAddr = .Offset(, ColDelimNum - 1).Address(External:=True)
        Data = .Resize(, Columns(ColFinal).Column - Columns(ColStart).Column + 1).Value
        ReDim Results(1 To Evaluate("SUMPRODUCT(LEN(" & ColDelimAddr & ")-LEN(SUBSTITUTE(" & ColDelimAddr & ","","",""""))+1)"), 1 To UBound(Data, 2))
    End With

    For iData = LBound(Data, 1) To UBound(Data, 1)
        For Each Part In Split(Data(iData, ColDelimNum), Delimiter)
            iResults = iResults + 1
            For j = LBound(Data, 2) To UBound(Data, 2)
                If j = ColDelimNum Then
                    Results(iResults, j) = Trim(Part)
                Else
                    Results(iResults, j) = Data(iData, j)
                End If
            Next j
        Next Part
    Next iData

    'This overwrites your original table with the split out result data
    'If you want the original table preserved, change the ColStart & RowStart to be where you want the output
    'Example: ws.Range("E1").Resize(......
    ws.Range(ColStart & RowStart).Resize(UBound(Results, 1), UBound(Results, 2)).Value = Results

End Sub

Answer 2

Another option is using Power Query; now named Get & Transform. It is an Add-in, released since Excel 2010 version, for ETL (Extract, Transform, Load)/ developed for Data Analysis. There you can connect multiple sources and transform the data as you want.

We can check step by step in Applied Steps and it also has its own code known as Power M Language; We can find it in Advanced Editor , in Home tab, where we can see and edit, line by line, your transformation steps.

let
    Source = Excel.CurrentWorkbook(){[Name="Table3"]}[Content],
    #"Split Column by Delimiter" = Table.SplitColumn(Source, "Items", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), {"Items.1", "Items.2"}),
    #"Changed Type" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Items.1", type text}, {"Items.2", type text}}),
    #"Unpivoted Other Columns" = Table.UnpivotOtherColumns(#"Changed Type", {"Category"}, "Attribute", "Value"),
    #"Removed Columns" = Table.RemoveColumns(#"Unpivoted Other Columns",{"Attribute"}),
    #"Renamed Columns" = Table.RenameColumns(#"Removed Columns",{{"Value", "Item"}})
in
    #"Renamed Columns"