Split rows based on number of linebreaks in cell VBA - excel

Question

I have a financial data with serial numbers linked to asset. The serial numbers are listed in cell through line breaks, i.e. there could 3,4,5 etc. serial no in a cell. So, the idea is copy and insert rows based on how many serial numbers are linked to asset in selected range. i.e. if there 4 serial no, then row should be split into 4 rows. The issue my code is that once I'm selected the range to be split, no matter that 3 or more serial numbers exist in first row it's slit into two rows, but the rest cells in range are split correctly. Not sure why the cycle within first cell in a range ends wrong.
Public Sub separate_line_range()
Dim target_col As Range
myTitle = "Select cells to be split"
Set target_col = Application.Selection
Set target_col = Application.InputBox("Select a range of cells that you want to split", myTitle, target_col.Address, Type:=8)
ColLastRow = target_col
Application.ScreenUpdating = False
For Each rng In target_col
If InStr(rng.Value, vbLf) Then
rng.EntireRow.Copy
rng.EntireRow.Insert
rng.Offset(-1, 0) = Mid(rng.Value, 1, InStr(rng.Value, vbLf) - 1)
rng.Value = Mid(rng.Value, Len(rng.Offset(-1, 0).Value) + 2, Len(rng.Value))
End If
Next
ColLastRow2 = target_col
For Each Rng2 In target_col
If Len(Rng2) = 0 Then
Rng2.EntireRow.Delete
End If
Next
Application.ScreenUpdating = True
End Sub
Please find imagine below:

Answer 1

I don't exactly know your task, so I put something relatively close to your task.
The issue of not correctly loop through all row is because the "RNG" you selected will not be resized after each insert row.
e.g. You are selecting row A1:C20, and there are two row added. Now the #19 and #20 are now A21:C21 & A22:C22. But the RNG is still A1:C20. The final two row will not be within the loop.
To solve your issue,
Use For i = LastRow to First Row Step -1 (Next) instead of For Each (Loop)
Here is something I do similar to your task (What I believe)
Sub Insertrow()
Dim i As Integer
Dim Lastrow As Integer
Lastrow = Worksheets("FMS1").Cells(1, 12)
For i = Lastrow To 1 Step -1
If Worksheets("FMS1").Range("J" & i) <> Worksheets("FMS1").Range("J" & i + 1) Then
Worksheets("FMS1").Range("J" & i + 1).EntireRow.Insert
Else
End If
Next
End Sub

Answer 2

Imagine the following data
and the following code
Option Explicit
Public Sub SplitLineBreaksIntoCells()
Const MyTitle As String = "Select cells to be split" ' define it as constant
Dim TargetCol As Range
On Error Resume Next ' next line errors if user presses cancel
Set TargetCol = Application.InputBox("Select a range of cells that you want to split", MyTitle, Application.Selection.Address, Type:=8)
On Error GoTo 0
If TargetCol Is Nothing Then
' User pressed cancel
Exit Sub
End If
Dim iRow As Long
For iRow = TargetCol.Rows.Count To 1 Step -1 ' loop from bottom to top when adding rows or row counting goes wrong.
Dim Cell As Range ' get current cell
Set Cell = TargetCol(iRow)
Dim LinesInCell() As String ' split data in cell by line break int array
LinesInCell = Split(Cell.Value, vbLf)
Dim LinesCount As Long ' get amount of lines in that cell
LinesCount = UBound(LinesInCell) + 1
' insert one cell less (one cell can be re-used)
Cell.Resize(RowSize:=LinesCount - 1).EntireRow.Insert Shift:=xlShiftDown
' inert the values from the spitted array
Cell.Offset(RowOffset:=-LinesCount + 1).Resize(RowSize:=LinesCount).Value = Application.Transpose(LinesInCell)
Next iRow
End Sub
You will get this as result: