Split cell with multiple lines into rows

Question

I have a workbook with cells that have linebreaks (entered via ALT + ENTER).

I have to separate them into individual rows. All the cells are in column A.

Each line in the cell has a bullet point (eg. "* ") up front, which could serve as a beacon to break the line at this point.

Answer 1

There is no need of code for this, lets make it simple.

Follow the bellow steps.

Select the data-set you want to split -> Go to Data Tab -> Select "Text to columns" -> from this pop-up select "Delimited" -> Select which delimiter is separating your texts -> Select the destination cell -> Click "OK"

Try This.

Regards, Ashwin

Edit from Markus: For the newline as delimiter use "Ctr-J"

Answer 2

Sub extract()

'Query extract data in cell B divided by ALT+Enter, Comma space 'Mandatory to create in front Sheet1, Sheet2, and Sheet3 'ATTENTION! if field B is empty return no data!! Manually add column A (with empty column B)if needed!! 'manually remove empty cell in results (Sheet2) 'before START Query remove duplicate from input data!! 'Doesn't work with full stop 'When finished Msg Done will be display

Dim c As Long, r As Range, I As Long, d As Long, Temp() As String d = 0 For Each r In Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row) ' Change this to suit your range.. c = 2 Temp = Split((r.Value), Chr(10)) For i = LBound(Temp) To UBound(Temp)

        Sheets("Sheet2").Cells(r.Row, c - 1).Offset(d, 0).Value = Cells(r.Row, r.Column - 1).Value
        Sheets("Sheet2").Cells(r.Row, c).Offset(d, 0).Value = Temp(i)
        Cells(r.Row, c).Offset(d, 0).Select
        ActiveCell.Value = Trim(ActiveCell.Value)
        d = d + 1
    Next
    d = d - 1
Next
Sheets("Sheet2").Select
Columns("A:B").Select
ActiveSheet.Range("$A$1:$B$62856").RemoveDuplicates Columns:=Array(1, 2), _
    Header:=xlYes
Range("A1").Select

Answer 3

You can use split with Chr(10) or VbLf

Dim cell_value As Variant
Dim counter As Integer

'Row counter
counter = 1

'Looping trough A column define max value
For i = 1 To 10

    'Take cell at the time
    cell_value = ThisWorkbook.ActiveSheet.Cells(i, 1).Value

    'Split cell contents
    Dim WrdArray() As String
    WrdArray() = Split(cell_value, vbLf)

    'Place values to the B column
    For Each Item In WrdArray
        ThisWorkbook.ActiveSheet.Cells(counter, 2).Value = Item
        counter = counter + 1
    Next Item


Next i

No you have array to place each row to different cell

Answer 4

If you select the cell and run the macro you would get what you want on the next column like this:

Option Explicit

Public Sub selection_into_rows()


    Dim k           As Variant
    Dim l_counter   As Long

    k = Split(Selection, Chr(10))

    For l_counter = LBound(k) To UBound(k)
        Cells(l_counter + 1, Selection.Column + 1) = k(l_counter)
    Next l_counter

End Sub

Answer 5

This will work on one row only after selecting it (but should get you started):

Option Explicit

Public Sub SelectionIntoRows()

Dim k() As String
Dim l As Long
Dim i As Long

k() = Split(Range("A1"), " ")
i = 1
For l = 0 To UBound(k)
    Cells(i, 1) = k(l)
    i = i + 1
Next l

End Sub