Split text in cells at line breaks

Question

I am working on an Excel spreadsheet that has data in 39 columns. One of these columns, column AJ, is a description field, and contains text describing the row item in detail. This text inside the cell sometimes is more than one line long and new lines have been started by pressing (ALT+Enter).

I need to be able to copy the entire sheet and place it all in another sheet (existing sheet), but with a new row for each new line in column AJ, as follows:

Column A     Column B     Column AJ
Electrical   Lighting     This is line one of the text
                          And in the same cell on a new line

This is the required result:

Column A     Column B     Column AJ
Electrical   Lighting     This is line one of the text
Electrical   Lighting     And in the same cell on a new line

I have searched the forums for similar code, but I am having trouble adapting it for my own purpose.

UPDATE: Not sure exactly why this has been closed, assume you maybe want an example of some code. I was using the below macro, that I found on the internet:

Sub Splt()
Dim LR As Long, i As Long
Dim X As Variant
Application.ScreenUpdating = False
LR = Range("AJ" & Rows.Count).End(xlUp).Row
Columns("AJ").Insert
For i = LR To 1 Step -1
    With Range("B" & i)
        If InStr(.Value, ",") = 0 Then
            .Offset(, -1).Value = .Value
        Else
            X = Split(.Value, ",")
            .Offset(1).Resize(UBound(X)).EntireRow.Insert
            .Offset(, -1).Resize(UBound(X) - LBound(X) + 1).Value = Application.Transpose(X)
        End If
    End With
Next i
Columns("AK").Delete
LR = Range("AJ" & Rows.Count).End(xlUp).Row
With Range("AJ1:AK" & LR)
    On Error Resume Next
    .SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
    On Error GoTo 0
    .Value = .Value
End With
Application.ScreenUpdating = True
End Sub

But it is not working, maybe I have adapted it incorrectly.

General logic: Copy sheet first, then only look at column A to see if cell in row is empty. If it is empty, fill A & B with the one above it and move to the next row. — Automate This, Nov 08 '13 at 05:35
I can't think of a macro or vbscript that can do this now. You might have to do some manual work here by using the **Data>Text to Columns** feature in excel and select Other checkbox, then press **Ctrl+J** as the delimiter. This will separate the texts at each carriage return — Chelseawillrecover, Nov 08 '13 at 05:47
@Chelseawillrecover I should have mentioned that it is a task that will need to be done over and over so I will need to automate it with a macro. Also I can't make text to columns work for rows. — matt9292, Nov 08 '13 at 06:09
@PortlandRunner note that the items shown in column AJ in the example are in the same cell — matt9292, Nov 08 '13 at 06:10

score 13 · Accepted Answer · answered Nov 08 '13 at 06:53

13

Try with this code:

Sub JustDoIt()
    'working for active sheet
    'copy to the end of sheets collection
    ActiveSheet.Copy after:=Sheets(Sheets.Count)
    Dim tmpArr As Variant
    Dim Cell As Range
    For Each Cell In Range("AJ1", Range("AJ2").End(xlDown))
        If InStr(1, Cell, Chr(10)) <> 0 Then
            tmpArr = Split(Cell, Chr(10))

            Cell.EntireRow.Copy
            Cell.Offset(1, 0).Resize(UBound(tmpArr), 1). _
                EntireRow.Insert xlShiftDown

            Cell.Resize(UBound(tmpArr) + 1, 1) = Application.Transpose(tmpArr)
        End If
    Next
    Application.CutCopyMode = False
End Sub

BEFORE-----------------------------------------AFTER

enter image description here

answered Nov 08 '13 at 06:53

Kazimierz Jawor

18,861
7
35
55

Thanks KazJaw, that works well for the first part of the macro, it is now creating a new row for each line-within-a-cell, however it is not splitting up the text between the rows. For example, a cell in column AJ with 5 lines inside it has been copied onto a new row 5 times, which is what I wanted, but it is not splitting the text between the rows. – matt9292 Nov 10 '13 at 22:22
sorry, I don't get your problem now. Try to figure it out on your own. As you can see you have solution which works what is presented on the screen shots. – Kazimierz Jawor Nov 10 '13 at 22:26
I don't know why, but I'm not getting the same result as you. For example, AJ2 and AJ3 have the same text (AAA BBB) and so on down the rows – matt9292 Nov 10 '13 at 22:43
I have made a new worksheet and replicated what you are doing exactly, and it works. Sorry, there's nothing wrong with your code, do you have any suggestions why it might not be working for me? – matt9292 Nov 10 '13 at 23:01
All working KazJaw, stupid mistake on my end, thanks very much for your help – matt9292 Nov 11 '13 at 05:52
How would this answer be adjusted if I had 2 columns like AJ in this example. (2 of the columns have line breaks in the cells, of the same amount). for instance: Column C: [1 2 3 4 5] [value1 value2 value3 value4 value 5]? – tribe84 Dec 16 '13 at 12:37

joshhemphill · Answer 2 · 2020-07-28T01:00:01.247

2

Use =SUBSTITUTE(A1,CHAR(10),";") to replace line-breaks with ";" or some other delineator so the text-to-column can parse it for you with one of the available delineators.

edited Jul 28 '20 at 01:00

answered May 24 '18 at 14:57

joshhemphill

492
6
20

score 1 · Answer 3 · edited Sep 23 '16 at 07:09

I had some issues getting Kazimierz code to work until I specified exactly which sheet it should be targeting. My scenario was a multi sheet arrangement and through some investigation I found the code was focussing on other sheets in the second nested loop - for unknown reason. Should the code not work for you, I suggest trying the below snippet.

In the line Set mtd = Sheets("SplitMethod") change the name to that of your source sheet. Change B1 and B2 in the next line to your target column, leaving 1 and 2 in place. This assumes your columns had a header in row 1. If there's no header, Change B2 to B1 also.

Sub JustDoIt()
    'working for active sheet
    'copy to the end of sheets collection
    Worksheets("SplitMethod").Activate
    ActiveSheet.Copy after:=Sheets(Sheets.Count)
    Dim tmpArr As Variant
    Dim Cell As Range
    Dim mtd As Worksheet
    Set mtd = Sheets("SplitMethod")

    For Each Cell In mtd.Range("B1", mtd.Range("B2").End(xlDown))

        If InStr(1, Cell, Chr(10)) <> 0 Then

            tmpArr = Split(Cell, Chr(10))

            Cell.EntireRow.Copy
            Cell.Offset(1, 0).Resize(UBound(tmpArr), 1). _
                EntireRow.Insert xlShiftDown

            Cell.Resize(UBound(tmpArr) + 1, 1) = Application.Transpose(tmpArr)
        End If
    Next
    Application.CutCopyMode = False
End Sub

score 0 · Answer 4 · answered Dec 12 '17 at 08:50

The above macros did not work for me. I tried a simple non macro based way to do this. For our example let us assume you have only two columns A and B. B has your content with the newline character.

Split the second column ( Column B) based on newline in to multiple columns and give special delimiter CTRL+J (Data --> Text to Columns)
Copy column A,B and paste in a different sheet in Column A,B of new sheet.
Copy column A,C and paste paste below the first set of data in Column A,B of new sheet.
Repeat this until the column in original sheet does not have any data.
In the new sheet delete all rows where column B is empty.

user3471272 · Answer 5 · 2018-04-17T11:58:42.433

Here is a formula solution:

Image shown here

Cell J1 is the delimiter. In this case a line break.

Helper:=SUM(D1,LEN(C1)-LEN(SUBSTITUTE(C1,$J$1,"")))+1

You must fill the above formula one row more.

F1:=a1

Fill this formula to the right.

F2:=LOOKUP(ROW(1:1),$D:$D,A:A)&""

Fill this formula to the right and down.

H2:=MID($J$1&LOOKUP(ROW(B1),$D:$D,C:C)&$J$1,FIND("艹",SUBSTITUTE($J$1&LOOKUP(ROW(B1),$D:$D,C:C)&$J$1,$J$1,"艹",ROW(B2)-LOOKUP(ROW(B1),$D:$D)))+1,FIND("艹",SUBSTITUTE($J$1&LOOKUP(ROW(B1),$D:$D,C:C)&$J$1,$J$1,"艹",ROW(B2)-LOOKUP(ROW(B1),$D:$D)+1))-FIND("艹",SUBSTITUTE($J$1&LOOKUP(ROW(B1),$D:$D,C:C)&$J$1,$J$1,"艹",ROW(B2)-LOOKUP(ROW(B1),$D:$D)))-1)&""

Fill down.

Bug:

Numbers will be converted to Text. Of course you can remove the &"" at the end of the formula, but blank cells will be filled with 0.

Split text in cells at line breaks

5 Answers5

Linked