Split text in cells from multiple columns in a range of rows into several lines - excel

Question

There is a table with each row needs to be separated so as there is only one name/date/transfer method in a cell in each row. I was able to separate it by names but I struggle to get the dates and e-mail-thing right, because sometimes the cells in respective columns are empty:
Desired result
I did this for names:
Sub splitcells()
Dim splitVals As Variant
Dim totalVals As Long
Set sh1 = ThisWorkbook.Sheets(1)
Set sh2 = ThisWorkbook.Sheets(2)
lrow1 = sh1.Range("A65356").End(xlUp).Row
For j = 2 To lrow1
splitVals = split(sh1.Cells(j, 2), Chr(10))
For i = LBound(splitVals) To UBound(splitVals)
lrow2 = sh2.Range("B65356").End(xlUp).Row
lrow3 = sh2.Range("A65356").End(xlUp).Row
sh2.Cells(lrow3 + 1, 1) = sh1.Cells(j, 1)
sh2.Cells(lrow3 + 1, 2) = splitVals(i)
Next i
Next j
End SubI tried to do the same thing for the rest by moving all the column indicators to column 3 like below, but it doesn`t work properly, filling dates in every cell in a column while some of them should be empty:
Sub splitcells2()
Dim splitVals As Variant
Dim totalVals As Long
Set sh1 = ThisWorkbook.Sheets(1)
Set sh3 = ThisWorkbook.Sheets(3)
lrow1 = sh1.Range("A65356").End(xlUp).Row
For j = 2 To lrow1
splitVals = split(sh1.Cells(j, 3), Chr(10))
For i = LBound(splitVals) To UBound(splitVals)
lrow2 = sh3.Range("B65356").End(xlUp).Row
lrow3 = sh3.Range("A65356").End(xlUp).Row
sh3.Cells(lrow3 + 1, 1) = sh1.Cells(j, 1)
sh3.Cells(lrow3 + 1, 2) = splitVals(i)
Next i
Next j
End Sub

Answer 1

If I understand you correctly, maybe something like this ?
Sub test()
Dim splitVals As Variant
Set sh1 = ThisWorkbook.Sheets(1)
Set sh2 = ThisWorkbook.Sheets(2)
colcount = 6 'change if not the same with the actual table
lrow1 = sh1.Range("A65356").End(xlUp).Row
For j = 2 To lrow1
Set oFill = sh2.Range("A65356").End(xlUp).Offset(1, 0)
With sh1.Cells(j, 2)
If InStr(.Value, Chr(10)) Then
cnt = Len(.Text) - Len(Replace(.Text, Chr(10), "")) + 1
Set oFill = oFill.Resize(cnt, 1)
End If
End With
For i = 1 To colcount
With sh1.Cells(j, i)
If InStr(.Value, Chr(10)) Then
splitVals = Application.Transpose(Split(.Value, Chr(10)))
Else
splitVals = .Value
End If
End With
oFill.Offset(0, i - 1).Value = splitVals
Next i
Next j
End Sub
The code has two loop. The first, loop to each row in column A, the second, loop to each column of the table.
At the first loop, it check if the looped cell offset(j,2) has a line break then it set the oFill (the target cell to be filled) to resize as much as the rows needed.
At the second loop, it check if the looped cell has a line break then it get the value of the looped cell with split function as splitVals variable. If no line break, the splitVals value is the same with the looped cell. Then finally it put the splitVals to the oFill range. Do the same with the rest of the column.
Please be noticed, the code assumes that if in column B there are N names, then the rest of the column (same row) value is either with N lines or blank.
After from VBasic2008 help to my code, please change this line:
lrow1 = sh1.Range("A65356").End(xlUp).Row
Set oFill = sh2.Range("A65356").End(xlUp).Offset(1, 0)
into something like this :
lrow1 = sh1.Range("A" & rows.count).End(xlUp).Row
Set oFill = sh2.Range("A" & rows.count).End(xlUp).Offset(1, 0)