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

 

[Sam_D_Ben]

May be something like this,

Sub CopyUnmergeFillTable()
    Dim ws          As Worksheet
    Dim sourceRange As Range, copiedRange As Range
    Dim lastRowP    As Long, lastRowR As Long, lastRowZ As Long, lastRow As Long
    Dim col         As Range
    Dim i           As Long
    
    Set ws = ActiveSheet
    
    lastRowP = ws.Cells(ws.Rows.Count, "P").End(xlUp).Row
    lastRowR = ws.Cells(ws.Rows.Count, "R").End(xlUp).Row
    lastRowZ = ws.Cells(ws.Rows.Count, "Z").End(xlUp).Row
    
    lastRow = Application.Max(lastRowP, lastRowR, lastRowZ)
    
    Set sourceRange = ws.Range("P1:Z" & lastRow)
    
    lastRow = lastRow + 3
    
    sourceRange.Copy ws.Range("P" & lastRow)
    
    Set copiedRange = ws.Range("P" & lastRow & ":Z" & (lastRow + sourceRange.Rows.Count - 1))
    copiedRange.UnMerge
    
    For Each col In copiedRange.Columns
        For i = 2 To copiedRange.Rows.Count
            If IsEmpty(col.Cells(i, 1).Value) Then
                col.Cells(i, 1).Value = col.Cells(i - 1, 1).Value
            End If
        Next i
    Next col
    
    MsgBox "Table copied, unmerged, And filled down While keeping the original unchanged!", vbInformation
End Sub

 

[Fluff]

@Sam_D_Ben I don't think the cells are merged, they are just single cells & some in col Z have multiple lines.

 

[Sam_D_Ben]

@Sam_D_Ben I don't think the cells are merged, they are just single cells & some in col Z have multiple lines.

This is what i am seeing when i paste it on xl, and the result below, Also i added some extra rows just incase.

Book1
	P	Q	R	S	T	U	V	W	X	Y	Z
1	Column P		Column R								Column Z
2	green		january								test1
3	yellow		august								test1
4											test2
5											test3
6	purple		june								test4
7	green		january								test1
8	yellow		august								test1
9											test2
10											test3
11	purple		june								test4
12
13
14	Column P		Column R								Column Z
15	green		january								test1
16	yellow		august								test1
17	yellow		august								test2
18	yellow		august								test3
19	purple		june								test4
20	green		january								test1
21	yellow		august								test1
22	yellow		august								test2
23	yellow		august								test3
24	purple		june								test4
Sheet1

 

[Fluff]

That's just how Excel interprets the data. The OP clearly says

In Column Z I have some rows with multiple lines of data within a cell

Which is not in the data you posted.

 

[Sam_D_Ben]

That's just how Excel interprets the data. The OP clearly says

Which is not in the data you posted.

Oh! You mean column Z3 has also been merged. correct? Or I am confused with the word <"multipe lines">

 

[Tom.Jones]

Oh! You mean column Z3 has also been merged. correct? Or I am confused with the word <"multipe lines">

"multiple line" in a cell mean
test1--> Alt+Enter --> test2 --> Alt+Enter --> test3 --> Alt+Enter
Cell z3 is made with Alt+Enter

 

[Sam_D_Ben]

"multiple line" in a cell mean
test1--> Alt+Enter --> test2 --> Alt+Enter --> test3 --> Alt+Enter
Cell z3 is made with Alt+Enter

Oh i got it, Thank You lol

 

[Peter_SSs]

Give this a try with a copy of your data.

Sub Rearrange()
  Dim Bits As Variant
  Dim r As Long, n As Long
  
  Application.ScreenUpdating = False
  For r = Range("Z" & Rows.Count).End(xlUp).Row To 2 Step -1
    Bits = Split(Range("Z" & r).Value, Chr(10))
      For n = UBound(Bits) To 1 Step -1
        Rows(r + 1).Insert
        Range("P" & r + 1).Value = Range("P" & r).Value
        Range("R" & r + 1).Value = Range("R" & r).Value
        Range("Z" & r + 1).Value = Bits(n)
      Next n
      Range("Z" & r).Value = Bits(0)
  Next r
  Application.ScreenUpdating = True
End Sub

 

[DanteAmor]

Here another option

Sub split_cell()
  Dim a As Variant, b As Variant, nLines As Variant, itm As Variant
  Dim i As Long, nMax As Long, k 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 Each itm In nLines
      k = k + 1
      b(k, 1) = a(i, 1)
      b(k, 3) = a(i, 3)
      b(k, 11) = itm
    Next
  Next

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