Splitting a row with multiple lines of text to different rows

Question

Hello all,&nbsp;I have an excel sheet in which some rows have multiple lines of text and some have only one line.I want to convert all those rows which have multiple lines to separate rows.See example below.&nbsp;Original table:OrderLineDateSupplier12121/12/20201/25/2020Supplier1Supplier23311/17/2019Supplier3&nbsp;Converted table:OrderLineDateSupplier111/12/2020Supplier1221/25/2020Supplier23311/17/2019Supplier3&nbsp;Any ideas on how to achieve that? preferable without a macro.&nbsp;Thanks,Liron.

jkpieterse · Answer

Eizenman I'm guessing the data is pasted into Excel from elsewhere, perhaps it is easier to try a different way to get that data into Excel? What is the source of this table?

eizenman · Answer

I don't have a way to change how I get the data

abiola1 · Answer

The question wasnt clear enough.

jkpieterse · Answer

Eizenman I'm not sure why you don't want to use VBA, but I couldn't come up with an easy alternative. The code below assumes all cells on a row contain the same number of "lines":
Option Explicit

Sub SplitTableROws()
    Dim Data As Variant
    Dim NewData As Variant
    Dim SplitData As Variant
    Dim DataRow As Long
    Dim NewDataRow As Long
    Dim Col As Long
    Dim Line As Long

Data = ActiveSheet.Range("A1").CurrentRegion.Value
    NewData = Application.Transpose(Data)
    For DataRow = LBound(Data, 1) To UBound(Data, 1)
        NewDataRow = NewDataRow + 1
        If InStr(Data(DataRow, 1), Chr(10)) &gt; 0 Then
            ReDim Preserve NewData(1 To UBound(Data, 2), 1 To NewDataRow + UBound(Split(Data(DataRow, 1), Chr(10))))
            For Col = LBound(Data, 2) To UBound(Data, 2)
                SplitData = Split(Data(DataRow, Col), Chr(10))
                For Line = LBound(SplitData) To UBound(SplitData)
                    NewData(Col, NewDataRow + Line) = SplitData(Line)
                Next
            Next
            NewDataRow = NewDataRow + Line - 1
        Else
            ReDim Preserve NewData(1 To UBound(Data, 2), 1 To NewDataRow)
            For Col = LBound(Data, 2) To UBound(Data, 2)
                NewData(Col, NewDataRow) = Data(DataRow, Col)
            Next
        End If
    Next DataRow
    Range("F1").Resize(NewDataRow, UBound(Data, 2)).Value = Application.Transpose(NewData)
End Sub

eizenman · Answer

JKPieterse&nbsp; I ran it but it just creates duplicated the column headers to the right of the existing columns without splitting the rows.&nbsp;Am I supposed to take additional steps?

Forum Discussion

Splitting a row with multiple lines of text to different rows

7 Replies

Resources

Order	Line	Date	Supplier
1 2	1 2	1/12/2020 1/25/2020	Supplier1 Supplier2
3	3	11/17/2019	Supplier3