CODEWITHSUNDEEP
excelvba
matt9292
matt9292

Reputation: 411

Split text in cells at line breaks

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.

Upvotes: 7

Views: 37789

Answers (5)

joshhemphill
joshhemphill

Reputation: 602

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.

Upvotes: 2

user3471272
user3471272

Reputation: 55

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.

Upvotes: 0

ambassallo
ambassallo

Reputation: 970

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.

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

Upvotes: 0

anakaine
anakaine

Reputation: 11

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

Upvotes: 1

Kazimierz Jawor
Kazimierz Jawor

Reputation: 19067

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 enter image description here

Upvotes: 13

Related Questions