Search code examples
vbaexcelline-breaks

Is it possible to split cells with line breaks into multiple rows in a range?


I have a range of data , where some of the cells have line breaks, and I need to split the line breaks into rows below where the line break occurs, but leave the other cells as is. There are also multiple columns if that makes a difference.

I have used the two answers provided below, with some adjustments to fit my worksheet, but neither is working for splitting ALL the cells. I ended up even trying both, but that does not work either.

When there is a line break in column A, it is working, but when there is not a line break in column A, and there is in another column, it does not work. If there is NOT a line break in column A, I just need to split the row where there is a line break and merge it into the row below.

Here are the codes:

end_row = range("A" & Rows.count).End(xlUp).row

range("A:A").TextToColumns Destination:=range("a1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
    :="   ", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True

For i = 1 To end_row
    row_added = False
    For j = 1 To 4
        If InStr(1, Cell, Chr(10)) <> 0 Then
            If Not row_added Then
                Rows(i + 1).Insert
                row_added = True
                end_row = end_row + 1
            End If
            Cells(i + 1, j) = Right(Cells(i, j), Len(Cells(i, j)) - InStr(1, Cell, Chr(10)))
            Cells(i, j) = Left(Cells(i, j), InStr(1, Cell, Chr(10)) - 1)
        End If
    Next j
Next i

And

Sub LFtoRow()
Dim myWS As Worksheet, myRng As range
Dim LastRow As Long, iLoop As Long, jLoop As Long
Dim myString() As String

Set myWS = ActiveSheet
LastRow = myWS.Cells(myWS.Rows.count, 1).End(xlUp).row

For iLoop = LastRow To 1 Step -1
    myString = Split(myWS.Cells(iLoop, 1), Chr(10))
    If UBound(myString, 1) > 0 Then
        myWS.Rows(iLoop + 1 & ":" & iLoop + UBound(myString, 1)).Insert shift:=xlShiftDown
        For jLoop = 0 To UBound(myString, 1)
            myWS.Cells(iLoop + jLoop, 1) = myString(jLoop)
        Next jLoop
    End If
Next iLoop

End Sub

Either a new code entirely, or just something to add to the end would work. I have an example of what is happening, and what I would like it to look like below. (I know it shows column B in the photo, but at this point in the MACRO it is in column A)

What is happening:

enter image description here

What I need to happen: enter image description here


Solution

  • This most likely is not the most concise way to do this, but this ended up working for me using @OldUgly's code.

    Sub LFtoRow()
    Dim myWS As Worksheet, myRng As range
    Dim LastRow As Long, iLoop As Long, jLoop As Long
    Dim myString() As String
    
    Set myWS = ActiveSheet
    LastRow = myWS.Cells(myWS.Rows.count, 1).End(xlUp).row
    
    For iLoop = LastRow To 1 Step -1
        myString = Split(myWS.Cells(iLoop, 1), Chr(10))
        If UBound(myString, 1) > 0 Then
            myWS.Rows(iLoop + 1 & ":" & iLoop + UBound(myString, 1)).Insert shift:=xlShiftDown
            For jLoop = 0 To UBound(myString, 1)
                myWS.Cells(iLoop + jLoop, 1) = myString(jLoop)
            Next jLoop
        End If
    Next iLoop
    
    For iLoop = LastRow To 1 Step -1
        myString = Split(myWS.Cells(iLoop, 2), Chr(10))
        If UBound(myString, 1) > 0 Then
            For jLoop = 0 To UBound(myString, 1)
                myWS.Cells(iLoop + jLoop, 2) = myString(jLoop)
            Next jLoop
        End If
    Next iLoop
    
    For iLoop = LastRow To 1 Step -1
        myString = Split(myWS.Cells(iLoop, 3), Chr(10))
        If UBound(myString, 1) > 0 Then
            For jLoop = 0 To UBound(myString, 1)
                myWS.Cells(iLoop + jLoop, 3) = myString(jLoop)
            Next jLoop
        End If
    Next iLoop
    
    For iLoop = LastRow To 1 Step -1
        myString = Split(myWS.Cells(iLoop, 4), Chr(10))
        If UBound(myString, 1) > 0 Then
            For jLoop = 0 To UBound(myString, 1)
                myWS.Cells(iLoop + jLoop, 4) = myString(jLoop)
            Next jLoop
        End If
    Next iLoop
    
    For iLoop = LastRow To 1 Step -1
        myString = Split(myWS.Cells(iLoop, 5), Chr(10))
        If UBound(myString, 1) > 0 Then
            For jLoop = 0 To UBound(myString, 1)
                myWS.Cells(iLoop + jLoop, 5) = myString(jLoop)
            Next jLoop
        End If
    Next iLoop
    
    End Sub