How to split a single cell into multiple rows?

Question

I have a table that has six columns. I would like the integer values in one single cell (F2) to be separated into multiple rows.

Additionally, I need the rows from A-E to be associated with integer.

I found a post akin to what I need, but it only works if you have two columns.

The code I have been trying to run

Sub ChickatAH()
    Dim rng As Range, Lstrw As Long, c As Range
    Dim SpltRng As Range
    Dim i As Integer
    Dim Orig As Variant
    Dim txt As String

    Lstrw = Cells(Rows.Count, "F").End(xlUp).Row
    Set rng = Range("A2:F" & Lstrw)

    For Each cell In rng.Cells
        Set SpltRng = cell.Offset(, 1)
        txt = SpltRng.Value
        Orig = Split(txt, Chr(10))
    For i = 0 To UBound(Orig)
        Cells(Rows.Count, "H").End(xlUp).Offset(1) = cell
        Cells(Rows.Count, "H").End(xlUp).Offset(, 1) = Orig(i)
    Next i
Next cell
End Sub

What have you done to that code to attempt to alter for your needs? — Scott Craner, Nov 27 '19 at 18:37
Here is one that does the whole row: https://stackoverflow.com/questions/42425208/vba-split-cell-values-into-multiple-rows-and-keep-other-data — Scott Craner, Nov 27 '19 at 18:41
I'm thinking this should be very doable through Power Query? Not tested. — JvdV, Nov 27 '19 at 18:43
@ScottCraner I tried this Lstrw = Cells(Rows.Count, "F").End(xlUp).Row Set rng = Range("A2:F" & Lstrw) — user716255, Nov 27 '19 at 18:57
Please [edit] your question to include the code and explain where it fails. Comments should not be used for code. — Scott Craner, Nov 27 '19 at 19:00

user716255 · Answer 1 · 2019-12-02T16:46:09.703

Modified the code on this post. It generated the solution I wanted. VBA: Split cell values into multiple rows and keep other data

Sub splitByColF()
    Dim r As Range, i As Long, ar
    Set r = Worksheets("Sheet1").Range("F999999").End(xlUp)
    Do While r.Row > 1
        ar = Split(r.Value, Chr(10))
        If UBound(ar) >= 0 Then r.Value = ar(0)
        For i = UBound(ar) To 1 Step -1
            r.EntireRow.Copy
            r.Offset(1).EntireRow.Insert
            r.Offset(1).Value = ar(i)
        Next
        Set r = r.Offset(-1)
    Loop
End Sub

How to split a single cell into multiple rows?

1 Answers1