How to convert a multi line excel cell to multi row while keeping other values the same?

Question

How can I convert a multi line cell to a multi row while keeping the data in other cells the same. Here is what I have and the desired result is shown below as well. Tried text to column but it converts it to multi column which is not what I am looking for. Here is what I have with over 100 rows.

Here is what the it should look like.

Any help would be appreciated..

Possible duplicate of [Split text in cells at line breaks](https://stackoverflow.com/questions/19851951/split-text-in-cells-at-line-breaks?utm_medium=organic&utm_source=google_rich_qa&utm_campaign=google_rich_qa) — Alon Adler, May 09 '18 at 20:54
I tried that solution already but it doesn’t seem to work with multi lines that have blank lines and or multiple returns. — Stryker, May 09 '18 at 21:08
Even though it is 100 lines, Each line has a cell that contains over 50 lines of text all in one cell. I have tried it with a few formulas with no luck. — Stryker, May 09 '18 at 21:10
The important question: are cells merged or text is in only one cell? — JohnyL, May 10 '18 at 11:58

score 2 · Accepted Answer · edited May 10 '18 at 10:45

this works for me.

Sub ConvertMultiLine()

    Dim cellVal     As String
    Dim WrdArray()  As String

    Dim Item        As Variant

    Dim iRow        As Long
    Dim Counter     As Long

    Dim colNum      As Integer  'column number where multi line cells are
        colNum = 3              'e.g. column "C"

    Dim rowStart    As Integer  'row number where the first multiline cell is
        rowStart = 2

    Dim rowPaste    As Integer  'row number where you want to paste the result
        rowPaste = 2            'if rowPaste = rowStart, the data will be overwritten

    Dim Arr()       As String   'array that will contain the separated values


    '1st loop to get the number of items (it's used to skip redim of 2D array)
    iRow = 0
    Counter = 0
    Do Until IsEmpty(ThisWorkbook.ActiveSheet.Cells(rowStart + iRow, colNum))

        'Split content of a cell
        cellVal = ThisWorkbook.ActiveSheet.Cells(rowStart + iRow, colNum).Value
        WrdArray() = Split(cellVal, vbLf)

        'Counting items
        For Each Item In WrdArray
            Counter = Counter + 1
        Next Item

        iRow = iRow + 1
    Loop

    '2nd loop to insert values into array
    iRow = 0
    ReDim Arr(1 To Counter, 1 To 3)
    Counter = 0
    Do Until IsEmpty(ThisWorkbook.ActiveSheet.Cells(rowStart + iRow, colNum))

        'Split content of a cell
        cellVal = ThisWorkbook.ActiveSheet.Cells(rowStart + iRow, colNum).Value
        WrdArray() = Split(cellVal, vbLf)

        'Set items to array
        For Each Item In WrdArray
            Arr(1 + Counter, 1) = ThisWorkbook.ActiveSheet.Cells(rowStart + iRow, colNum - 2)
            Arr(1 + Counter, 2) = ThisWorkbook.ActiveSheet.Cells(rowStart + iRow, colNum - 1)
            Arr(1 + Counter, 3) = Item
            Counter = Counter + 1
        Next Item

        iRow = iRow + 1
    Loop

    'Paste array
    ThisWorkbook.ActiveSheet.Cells(rowPaste, colNum - 2).Resize(Counter, 3) = Arr

End Sub

This worked like a charm. A few glitches here and there but it does the job. — Stryker, May 10 '18 at 15:13

JohnyL · Answer 2 · 2018-05-10T13:52:55.543

Assuming data is in columns A, B and C:

Sub G()

    Dim r&, x&, cnt%, arr
    Dim wksOutput As Worksheet
    Dim this As Worksheet

    x = 2 '//Skip header
    Set this = ActiveSheet
    Set wksOutput = Sheets.Add(After:=Sheets(Sheets.Count))

    With wksOutput
        For r = 2 To this.Cells(Rows.Count, 1).End(xlUp).Row
            arr = Split(this.Cells(r, "C"), Chr(10))
            cnt = UBound(arr) + 1
            .Cells(x, "A").Resize(cnt) = this.Cells(r, "A")
            .Cells(x, "B").Resize(cnt) = this.Cells(r, "B")
            .Cells(x, "C").Resize(cnt) = Application.Transpose(arr)
            x = x + cnt
        Next
    End With

End Sub

How to convert a multi line excel cell to multi row while keeping other values the same?

2 Answers2