Split cell contents by line break and put into new rows

[chive90]

In Column Z I have some rows with multiple lines of data within a cell, and some with just a single line of data in a cell.

For those where there are multiple lines of data (separated by a line break), I would like these inserted as new rows below the cell in question.

I would also like data from Columns P and R copied down from the row that has multiple lines of data. The other columns for the newly inserted rows can remain blank.

This is how it is currently formatted:

Column P	Column R	Column Z
green	january	test1
yellow	august	test1 test2 test3
purple	june	test4

This is how I would like it to be formatted:

Column P	Column R	Column Z
green	january	test1
yellow	august	test1
yellow	august	test2
yellow	august	test3
purple	june	test4

Is it possible to achieve this?

Thanks

 

[Peter_SSs]

Here another option

Wouldn't that option delete whatever data existed in the intervening columns?

 

[DanteAmor]

Hi Peter, always a pleasure to hear from you. I hope you are feeling very well and have an excellent year, full of health for you and your family.

Wouldn't that option delete whatever data existed in the intervening columns?

@chive90 ,
In the columns between P and Z do you have values?
What should happen to that data, should it stay in the first row?

If so, try the following macro:

Sub split_cell()
  Dim a As Variant, b As Variant, nLines As Variant, itm As Variant
  Dim i As Long, j As Long, nMax As Long, k As Long, n As Long
  
  a = Range("P2", Range("Z" & Rows.Count).End(3)).Value
  For i = 1 To UBound(a)
    nMax = nMax + (Len(a(i, 11)) - Len(Replace(a(i, 11), Chr(10), ""))) + 1
  Next
  ReDim b(1 To nMax, 1 To UBound(a, 2))
  
  For i = 1 To UBound(a)
    nLines = Split(a(i, 11), Chr(10))
    For n = 0 To UBound(nLines)
      k = k + 1
      If n = 0 Then
        For j = 1 To 11
          b(k, j) = a(i, j)
          If j = 11 Then b(k, j) = nLines(n)
        Next
      Else
          b(k, 1) = a(i, 1)
          b(k, 3) = a(i, 3)
          b(k, 11) = nLines(n)
      End If
    Next
  Next

  Range("P2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

Note: This macro does not respect if you have formulas in the cells. The advantage is that it is very fast with many cells.

 

[alansidman]

An alternative means with Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Table3"]}[Content],
    #"Split Column by Delimiter" = Table.ExpandListColumn(Table.TransformColumns(Source, {{"Column3", Splitter.SplitTextByDelimiter("#(lf)", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Column3")
in
    #"Split Column by Delimiter"