Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

VB script to split cells with carriage return into new rows

Posted on 2015-02-11
6
Medium Priority
?
178 Views
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.

Original data set - ALL IN ONE ROW IN SPREADSHEET W CARRIAGE RETURNS:
COL1       COL2     COL3    COL4     COL5     COL6
UNRD     SVO31    A1S      UNRD                   N
MTR                        AAI       MTR       ZZ
GRP                        ATB      GRP        AA
VMA                       AAA      VMA       BB

Required data set - DATA MOVED TO MULTIPLE ROWS IN SPREADSHEET:
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
0
Comment
Question by:azaun
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 2
6 Comments
 
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?
0
 

Author Comment

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

Author Comment

by:azaun
ID: 40608525
Anyone have any thoughts on a possible solution?
--corp.chartercom.com-Users-MO-Home-stl-
0
Office 365 Training for Admins - 7 Day Trial

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

 
LVL 10

Accepted Solution

by:
broro183 earned 2000 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
        .Worksheets(OutputShtName).Delete
        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


hth
Rob
0
 

Author Closing Comment

by:azaun
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:
ABC                  
DEF                  123
GHI                  456

Became:
ABC                 123
DEF                  456
GHI

Thanks!!
0
 
LVL 10

Expert Comment

by:broro183
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?

Rob
0

Featured Post

New benefit for Premium Members - Upgrade now!

Ready to get started with anonymous questions today? It's easy! Learn more.

Question has a verified solution.

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

This article describes a serious pitfall that can happen when deleting shapes using VBA.
Gain an elementary understanding of Blockchain technology.
This tutorial gives a high-level tour of the interface of Marketo (a marketing automation tool to help businesses track and engage prospective customers and drive them to purchase). You will see the main areas including Marketing Activities, Design …
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

722 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