Split cells by line break while keeping other data - excel

Question

I have multiple rows in a spreadsheet set up like the following:
TEST 1 Y N TEST_1 1234 Derived
TEST_2 56
I need to split the cells that have a line break while copying the remaining cells into the new row:
TEST 1 Y N TEST_1 1234 Derived
TEST 1 Y N TEST_2 56 Derived
I tested code by changing line breaks to commas (I don't know the VBA symbol for linebreak). The code I tried only works for one column E, not Column F:
Sub splitByCol()
Dim r As Range, i As Long, ar
Set r = Worksheets("Sheet1").Range("E999999:F999999").End(xlUp)
Do While r.row > 1
ar = Split(r.value, ",")
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

Answer 1

I just did a brief test, might not be perfect. If you have a ton of rows and columns this might be a tad slow aswell.
Dim rowiter As Long
Dim coliter As Long
Dim lastrow As Long
Dim lastcol As Long
Dim rowcount As Long
Dim rowadd As Boolean
With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
lastcol = .Cells.Find(What:="*", after:=ActiveSheet.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
rowcount = lastrow + 1
For rowiter = 1 To lastrow
rowadd = False
For coliter = 1 To lastcol
If InStr(1, .Cells(rowiter, coliter), vbLf) Then
.Cells(rowcount, coliter).Value = Split(.Cells(rowiter, coliter), vbLf)(1)
.Cells(rowiter, coliter).Value = Split(.Cells(rowiter, coliter), vbLf)(0)
rowadd = True
End If
Next
If rowadd = True Then
For coliter = 1 To lastcol
If .Cells(rowcount, coliter).Value = "" Or IsNull(.Cells(rowcount, coliter).Value) Then
.Cells(rowcount, coliter).Value = .Cells(rowiter, coliter).Value
End If
Next
rowcount = rowcount + 1
End If
rowadd = False
Next
.Range(Cells(1, 1), Cells(rowcount, lastcol)).Sort Key1:=Columns("A"), Order1:=xlDescending
End With

Answer 2

Actually you were almost there:
You need to split by vbLf instead of ","
You need to split column E and F into seperate arrays
So you end up with:
Option Explicit
Sub splitByCol()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim CurrentCell As Range
Set CurrentCell = ws.Range("E" & ws.Rows.Count).End(xlUp)
Dim ArrE As Variant 'split array for column E
Dim ArrF As Variant 'split array for column F
Do While CurrentCell.Row > 1
ArrE = Split(CurrentCell.Value, vbLf)
ArrF = Split(CurrentCell.Offset(ColumnOffset:=1).Value, vbLf)
If UBound(ArrE) >= 0 Then CurrentCell.Value = ArrE(0)
If UBound(ArrF) >= 0 Then CurrentCell.Offset(ColumnOffset:=1).Value = ArrF(0)
Dim i As Long
For i = UBound(ArrE) To 1 Step -1
CurrentCell.EntireRow.Copy
CurrentCell.Offset(1).EntireRow.Insert
CurrentCell.Offset(1).Value = ArrE(i)
If UBound(ArrF) >= i Then
CurrentCell.Offset(1, 1).Value = ArrF(i)
Else
CurrentCell.Offset(1, 1).Value = vbNullString
End If
Next i
Set CurrentCell = CurrentCell.Offset(-1)
Loop
End Sub
Input
Output