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?
Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

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

Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

Question has a verified solution.

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

Suggested Solutions

Today companies are subjected to more-and-more data, and it won't stop any time soon.  But there are obvious opportunities for reducing data, particularly data duplicated among companies.
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaac…

785 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