VB script to split cells with carriage return into new rows

Posted on 2015-02-11
Last Modified: 2015-02-24
I have a spreadsheet that contains columns with multiple cells with carriage returns.  I would like to split the carriage returns into new rows across the entire spreadsheet.

I would like a vb script to pull the data apart and place it into a new tab in the same workbook.

See the below for a sample dataset and required output.

COL1       COL2     COL3    COL4     COL5     COL6
UNRD     SVO31    A1S      UNRD                   N
MTR                        AAI       MTR       ZZ
GRP                        ATB      GRP        AA
VMA                       AAA      VMA       BB

R1     COL1       COL2      COL3     COL4      COL5      COL6
R2     UNRD     SVO31     A1S       UNRD                    N
R3     MTR                         AAI        MTR        ZZ
R4     GRP                         ATB       GRP         AA
R5     VMA                        AAA       VMA        BB
Question by:azaun
  • 3
  • 2
LVL 47

Expert Comment

by:Wayne Taylor (webtubbs)
ID: 40604465
So the data in each "column" is currently in a single cell? Can you post an actual workbook showing the layout?

Author Comment

ID: 40604589
Yes - the data in the original data set is in 1 row, multiple columns.  Spreadsheet below. Spreadsheet illustrationHaving trouble attaching actual spreadsheet.

Author Comment

ID: 40608525
Anyone have any thoughts on a possible solution?
Zoho SalesIQ

Hassle-free live chat software re-imagined for business growth. 2 users, always free.

LVL 10

Accepted Solution

broro183 earned 500 total points
ID: 40609431
hi Azaun,

I'm not sure if this is exactly what you want but give it a try. It relies on you selecting the range that you want to process BEFORE you start the macro. I'm not sure how experienced you are so I have added a lot of comments.
The sections with "***" are the probable areas that you may want to change.

Option Explicit

Sub SplitOutRows_v1()
Const LineBrk_Chr = vbLf    '***change as required if your line break character is not vblf
Const OutputShtName As String = "Output after splitting" '***

Dim InputRng As Range    'Original input range that is to be modified
Dim InputRngArr As Variant    'variant array containing the contents of the Input range. Used for speed of "in memory" processing.
Dim TotalReqNumOfRows As Long    'total required number of rows for the output range
Dim OutputRng As Range    'output range that is sized
Dim OutputRngArr As Variant  'Variant array used for speed of "in memory" processing.
Dim RowInd As Long    'Row Index for looping
Dim ColInd As Long    'column index for looping
Dim NumOfCols As Long    'number of columns (remains constant for input & output)
Dim ReqNewRowsForOriRow As Long    'required new number of rows within one of the original input range rows.
Dim OutputRow As Long    'used in the loop to define which row is populated in the range
Dim SplitCellArr As Variant    'a variant array that contains separate elements of the contents of a single cell from the input range.
Dim SplitCellInd As Long    'index for looping through the elements of a split cell

    '***This can be changed to choose the range based on logic but it currently uses the selected cells in the activesheet.
    Set InputRng = Selection '***
    'transfer the contents of the Input range to a variant array which is fast to transfer back to the worksheet.
    InputRngArr = InputRng
    NumOfCols = InputRng.Columns.Count

    'Loop through all rows of the input range & loop through each column of each row to find the maximum number of line breaks in all the cells for each row.
    For RowInd = LBound(InputRngArr) To UBound(InputRngArr)
        For ColInd = 1 To NumOfCols
            ReqNewRowsForOriRow = Application.WorksheetFunction.Max(ReqNewRowsForOriRow, UBound(Split(InputRngArr(RowInd, ColInd), LineBrk_Chr)) + 1)
        Next ColInd
        'adds the required number of new (output) rows to a total number of required rows. This will be used to define the size of the Output array / range
        TotalReqNumOfRows = TotalReqNumOfRows + ReqNewRowsForOriRow
        ReqNewRowsForOriRow = 0
    Next RowInd

    'delete the last output sheet if it exists
    With InputRng.Parent.Parent
        Application.DisplayAlerts = False
        On Error Resume Next
        On Error GoTo 0
        Application.DisplayAlerts = True

        'add a new output sheet
        With .Worksheets.Add(after:=InputRng.Parent)
            .Name = OutputShtName
            'define the size of the Output range
            Set OutputRng = .Cells(1, 1).Resize(TotalReqNumOfRows, NumOfCols)
        End With
    End With
    'define the size of the Output array by making it the same size as the output range
    OutputRngArr = OutputRng
    OutputRow = 1

    'loop through all rows of the Input array, split the contents into new rows based on
    'the presence of a specific linebreak character
    For RowInd = LBound(InputRngArr) To UBound(InputRngArr)
        For ColInd = 1 To NumOfCols
            SplitCellArr = Split(InputRngArr(RowInd, ColInd), LineBrk_Chr)
            ReqNewRowsForOriRow = Application.WorksheetFunction.Max(ReqNewRowsForOriRow, UBound(SplitCellArr) + 1)
            For SplitCellInd = LBound(SplitCellArr) To UBound(SplitCellArr)
                OutputRngArr(OutputRow + SplitCellInd, ColInd) = SplitCellArr(SplitCellInd)
            Next SplitCellInd
        Next ColInd
        OutputRow = OutputRow + ReqNewRowsForOriRow
        ReqNewRowsForOriRow = 0
    Next RowInd
    'write the in memory array to spreadsheet
    OutputRng = OutputRngArr
    Set OutputRng = Nothing
    Set InputRng = Nothing
    MsgBox "Done"
End Sub

Open in new window


Author Closing Comment

ID: 40626637
Rob - that worked for what I needed.  It didn't keep each column lined up perfectly, however for my purposes that wasn't critical.

For example:
DEF                  123
GHI                  456

ABC                 123
DEF                  456

LVL 10

Expert Comment

ID: 40627875
hi Azaun,

Thank you, I'm pleased I could help.

The code worked on the data set that I created & it works when I type your last example into excel as well. Can you please attach/upload a file saved in an excel format (ie xls, xlsx, xlsm or xlsb) that shows the error?


Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Hard coding time and date into Excel 2 33
Set email body to html using vbscript 6 28
increment numbers by 10 11 31
Vlookup formula error 15 12
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
An overview on how to enroll an hourly employee into the employee database and how to give them access into the clock in terminal.
XMind Plus helps organize all details/aspects of any project from large to small in an orderly and concise manner. If you are working on a complex project, use this micro tutorial to show you how to make a basic flow chart. The software is free when…

863 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now