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:

CodePudding user response：

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,

1. 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

CodePudding user response：

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: