Split text separated by commas in single cell into individual rows

[adunlap13]

Hi,

I have a spreadsheet with data in A3:G200. Column E has data that is sometimes separated by commas in a single cell but not all of the time. For example (E13 has "shu, tihg, est" and E14 has "uth") I am trying to have a new row inserted for each text that is separated by a comma without overwriting the data below it but instead just pushing it down. Ideally I would like to be able to run a macro that will take column E and input it on a new sheet in column A with the cells that have text separated by commas being put into their own rows. The list will grow overtime so if it can be done with that in mind that would be great. I have not been able to find this anywhere online so if someone has a quick code they can share I would really appreciate it. I am good with excel but struggle with the in depth coding part but I am trying to learn as I go.

Thank you in advance,

A

 

[oldbrewer]

abc

def

a simple formula marks the row with a 1 if a comma is present in column A

ghi, jkl

1

mno

a macro can now run down column B and where there is a "1" insert a new row below it

pqr, stu, vwx

1

yzz

<colgroup><col><col span="12"></colgroup><tbody>
</tbody>

 

[JLGWhiz]

Sub makeList()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, ary As Variant
Set sh1 = Sheets(1) 'Substitute 1 with sheet name in quotes for sheet with column E data.
Set sh2 = Sheets(2) 'Substitute 2 wutg sheet name in quotes for destination sheet
    For Each c In sh1.Range("E2", sh1.Cells(Rows.Count, 5).End(xlUp))
        If InStr(c.Value, ",") > 0 Then
            ary = Split(c.Value, ",")
            For i = LBound(ary) To UBound(ary)
                If UBound(ary) = 0 Then Exit For
                sh2.Cells(Rows.Count, 1).End(xlUp)(2) = ary(i)
            Next
        Else
            If c <> "" Then sh2.Cells(Rows.Count, 1).End(xlUp)(2) = c.Value
        End If
    Next
End Sub

 

[oldbrewer]

abc

def

ghi, jkl

1

mno

pqr, stu, vwx

1

yzz

a simple formula marks the row with a 1 if a comma is present in column A

a macro can now run down column B and where there is a "1" insert a new row below it

this macro has done the business…………….

For j = 1 To 50

If Cells(j, 1) = "" Then GoTo 100

If Cells(j, 2) = 1 Then Cells(j + 1, 1).Select: Selection.EntireRow.Insert: j = j + 1

Next j

100 End Sub

<colgroup><col><col span="12"></colgroup><tbody>
</tbody>