Solved

VB script to split cells with carriage return into new rows

Posted on 2015-02-11
6
104 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
  • 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
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 10

Accepted Solution

by:
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
        .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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

Suggested Solutions

Meetings to discuss business process can waste time, and often do .  The meeting's dialog can get confusing when participants have different professional perspectives and backgrounds.  A jointly-developed process picture helps wade through the confu…
PaperPort has a feature called the "Send To Bar". It provides a convenient, drag-and-drop interface for using other installed software, such as Microsoft Office. However, this article shows that the latest Office 2016 apps (installed with an Office …
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

707 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

12 Experts available now in Live!

Get 1:1 Help Now