CODEWITHSUNDEEP
excelvba
Armitage2k
Armitage2k

Reputation: 1274

Split cell with multiple lines into rows

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.

enter image description here

Upvotes: 1

Views: 30955

Answers (6)

Hans Schulze
Hans Schulze

Reputation: 164

I had a half dozen of these blobs from an poor Acrobat PDF to XLSX conversion, peppered throughout 500 rows. I copied the text blob (like OP) into Notepad, removed "" from the start and end line, and pasted to a new spreadsheet. That tells me how many lines to insert. Then pasted into that hole.

"This was all of my input text"

Then I could use TextToCol.

Upvotes: 0

Ashwin
Ashwin

Reputation: 247

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"

Upvotes: 2

Ivica
Ivica

Reputation: 1

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

Upvotes: 0

Brian
Brian

Reputation: 2108

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

Upvotes: 0

user4845680
user4845680

Reputation: 158

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

Upvotes: 3

Vityata
Vityata

Reputation: 43595

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

Upvotes: 0

Related Questions