Copy Sheet Rows to New Sheet Based on Split Cell Text

Question

I have a problem I need help with involving Excel and VBA. I know next to nothing about Excel/VBA, and I need a coding solution to help me avoid performing the extremely tedious task of doing this manually (think hundreds of lines that need to be parsed where one row could become multiple rows in a new sheet). I've been searching the web for solutions, but I just keep getting confused by the answers (because I don't know anything about VB and using it to program a macro in Excel), so I figured I'd seek help for my specific problem.

Here is the rundown: I have a spreadsheet where I need to copy rows from a source sheet to a target sheet. The source sheet has 2 columns (A & B) that can be thought of as a key/value pair where col A contains the key and col B contains the value. The problem lies with the values in col B. The values can either be a single line of text or a numbered list of different texts

What I want to do is for each row in the source:

• split the values in col B to get an array of each individual value (if the value is in the form of a numbered list)
• create new rows in the target sheet by looping over the split array of values such that a new row will be created where: new row col A = source row col A key and new row col B = current iteration index from the array of split values.
• if no numbered list, just copy the source row into target sheet

Source

A B key1 1. text1 2. text2 key2 1. text3

Target

A B key1 text1 key1 text2 key2 text3

The numbered list in a cell will be multiple lines where each line of text is prepended by a decimal and a dot. This applies to single line cells as well.

(Update) Bear in mind that the values in either col A or B are not simple text values. These are full on sentences. So, I'm not sure a simple formula is going to work.

Answer 1

You can do this with two formulas.

I'm assuming your data is in Sheet1.

For the first columns, use the following formula:

=IF(ISBLANK(Sheet1!A2),A1,Sheet1!A2)

For the second one use:

=IFERROR(RIGHT(Sheet1!B2,LEN(Sheet1!B2)-FIND(". ",Sheet1!B2)-1),Sheet1!B2)

And populate down.

edit:

The first formula will look at the corresponding cell in Sheet1, column A. If it is blank, it will take the value of the cell above where the formula is. If it isn't blank, it will take the value of the cell in Sheet1, column A that it just checked.

The second formula looks for the string ". " in the cells in Sheet1 column B and removes it and everything to the left of it from the text. If the string in question (". ") is not found (meaning there is no numbering in that given cell) it would return an error, so the whole thing is wrapped in an IFERROR statement which returns the value of the cell in Sheet1 column B if it is triggered.

Answer 2

Split Multi Line

It is unclear which line separator occurs in the multi line cells. Choose one, vbLf worked for me.

Adjust the values in the constants section to fit your needs.

The Code

Sub SplitMultiLine()

    Const cSheet1 As Variant = "Sheet1"   ' Source Worksheet Name/Index
    Const cFirstR As Integer = 1          ' Source First Row Number
    Const cFirstC As Variant = "A"        ' Source First Column Letter/Number
    Const cLastC As Variant = "C"         ' Source Last Column Letter/Number
    Const cMulti As Integer = 2           ' Multi Column
    Const cSplit As String = vbLf         ' Split Char(vbLf, vbCrLf, vbCr)
    Const cDot As String = "."            ' Dot Char (Delimiter)

    Const cSheet2 As Variant = "Sheet1"   ' Target Worksheet Name/Index
    Const cTarget As String = "E1"        ' Target First Cell Address

    Dim vntS As Variant       ' Source Array
    Dim vntSplit As Variant   ' Split Array
    Dim vntT As Variant       ' Target Array
    Dim lastR As Long         ' Source Last Row
    Dim i As Long             ' Source Array Row Counter
    Dim j As Integer          ' Source/Target Array Column Counter
    Dim k As Long             ' Target Array Row Counter
    Dim m As Integer          ' Split Array Row Counter

    ' Paste Source Range into Source Array.
    With Worksheets(cSheet1)
        lastR = .Cells(.Rows.Count, cFirstC).End(xlUp).Row
        vntS = .Range(.Cells(cFirstR, cFirstC), .Cells(lastR, cLastC))
    End With

    ' Count the number of rows in target array.
    For i = 1 To UBound(vntS)
        k = k + UBound(Split(vntS(i, cMulti), cSplit)) + 1
    Next

    ' Write from Source to Target Array.
    ReDim vntT(1 To k, 1 To UBound(vntS, 2))
    k = 0
    For i = 1 To UBound(vntS)
        k = k + 1
        vntSplit = Split(vntS(i, cMulti), cSplit)
        For m = 0 To UBound(vntSplit)
            If InStr(vntSplit(m), cDot) > 0 Then
                vntT(k, cMulti) = Trim(Right(vntSplit(m), Len(vntSplit(m)) _
                        - InStr(vntSplit(m), cDot)))
              Else
                vntT(k, cMulti) = vntSplit(m)
            End If
            For j = 1 To UBound(vntS, 2)
                If j <> cMulti Then
                    vntT(k, j) = vntS(i, j)
                End If
            Next
            k = k + 1
        Next
        k = k - 1
    Next

    ' Paste Target Array into Target Range calculated from Target Frist Cell.
    With Worksheets(cSheet2).Range(cTarget)
        .Resize(UBound(vntT), UBound(vntT, 2)) = vntT
    End With

End Sub

An Over-Commenting

Sub SplitMultiLineOverCommented()

    Const cSheet1 As Variant = "Sheet1"   ' Source Worksheet Name/Index
    Const cFirstR As Integer = 1          ' Source First Row Number
    Const cFirstC As Variant = "A"        ' Source First Column Letter/Number
    Const cLastC As Variant = "C"         ' Source Last Column Letter/Number
    Const cMulti As Integer = 2           ' Multi Column
    Const cSplit As String = vbLf         ' Split Char(vbLf, vbCrLf, vbCr)
    Const cDot As String = "."            ' Dot Char (Delimiter)

    Const cSheet2 As Variant = "Sheet1"   ' Target Worksheet Name/Index
    Const cTarget As String = "E1"        ' Target First Cell Address

    Dim vntS As Variant       ' Source Array
    Dim vntSplit As Variant   ' Split Array
    Dim vntT As Variant       ' Target Array
    Dim lastR As Long         ' Source Last Row
    Dim i As Long             ' Source Array Row Counter
    Dim j As Integer          ' Source/Target Array Column Counter
    Dim k As Long             ' Target Array Row Counter
    Dim m As Integer          ' Split Array Row Counter

    ' Paste Source Range into Source Array.
    With Worksheets(cSheet1)
        ' The last row of data is usually calculated going from the bottom up,
        ' it is like selecting the last cell and pressing CTRL UP and returning
        ' =ROW() in Excel.
        lastR = .Cells(.Rows.Count, cFirstC).End(xlUp).Row
        ' Paste a range into an array actually means copying it. The array
        ' created is a 1-based 2-dimensional array which has the same number
        ' of rows and columns as the Source Range.
        vntS = .Range(.Cells(cFirstR, cFirstC), .Cells(lastR, cLastC))
    End With

    ' Count the number of rows in Target Array.
    ' You refer to the last row of the array with UBound(vntS) which is short
    ' for UBound(vntS, 1) which reveals that it is referring to the first
    ' dimension (rows).
    For i = 1 To UBound(vntS)
        ' We are splitting the string by cSplit which is the line
        ' separator (delimiter). When you enter something into a cell and
        ' hold left Alt and press ENTER, the vbLf character is set in place
        ' of the line separator. But the data may have been imported from
        ' another system that uses another line separator. When splitting the
        ' string, a 0-based array is 'created' and its UBound is the last
        ' row, but since it is 0-based we have to add 1.
        k = k + UBound(Split(vntS(i, cMulti), cSplit)) + 1
    Next

    ' Write from Source to Target Array.
    ' After we have calculated the number of rows, we have to resize the
    ' Target Array. To avoid confusion, I always use '1 To' to be certain that
    ' it is a 1-based array. Since the number columns of the Source Array and
    ' the Target Array is the same, we use the UBound of the Source Array to
    ' resize the second dimension of the Target Array - UBound(vntS, 2) where
    ' 2 is indicating the second dimension, columns.
    ReDim vntT(1 To k, 1 To UBound(vntS, 2))
    ' We will use again k as the row counter since its value is no more
    ' needed. This is what I have many times forgotten, so maybe it is
    ' better to use a different variable.
    k = 0
    ' Loop through the columns of Source Array.
    For i = 1 To UBound(vntS)
        ' Increase the row of Target Array or e.g. align it for writing.
        k = k + 1
        ' Split the string (lines) in the Multi Column into the 0-based
        ' Split Array.
        vntSplit = Split(vntS(i, cMulti), cSplit)
        ' Loop through the values of the Split Array
        For m = 0 To UBound(vntSplit)
            ' Check if value contains cDot. The Instr function returns 0 if
            ' a string has not been found, it's like =FIND(".",A1) in Excel,
            ' except that Excel would return an error if not found.
            If InStr(vntSplit(m), cDot) > 0 Then
                ' If cDot was found then write the right part after cDot
                ' to the current row of column cMulti but trim the result
                ' (remove space before and after.
                ' It's like =TRIM(RIGHT(A1,LEN(A1)-FIND(".",A1))) in Excel.
                vntT(k, cMulti) = Trim(Right(vntSplit(m), Len(vntSplit(m)) _
                        - InStr(vntSplit(m), cDot)))
              Else
                ' If cDot was not found then just write the value to the
                ' current row.
                vntT(k, cMulti) = vntSplit(m)
            End If
            ' Loop through all columns.
            For j = 1 To UBound(vntS, 2)
                If j <> cMulti Then
                    ' Write to other columns (Not cMulti)
                    vntT(k, j) = vntS(i, j)
                End If
            Next ' Next Source/Target Array Column
            ' Increase the current row of Target Array before going to next
            ' value in Split Array.
            k = k + 1
        Next ' Next Split Array Row
        ' Since we have increased the last current row but haven't written to
        ' it, we have to decrease one row because of the "k = k + 1" right below
        ' "For i = 1 To UBound(vntS)" which increases the row of Target Array
        ' for each next row in Source Array.
        k = k - 1
    Next ' Next Source Array Row

    ' Paste Target Array into Target Range calculated from Target Frist Cell.
    ' Like we pasted a range into an array, we can also paste an array into
    ' a range, but it has to be the same size as the array, so by using
    ' the Resize method we adjust the Target Range First Cell to the Target
    ' Range, using the last row and column of the Target Array. Again,
    ' remember UBound(vntT) is short for UBound(vntT, 1) (rows).
    With Worksheets(cSheet2).Range(cTarget)
        .Resize(UBound(vntT), UBound(vntT, 2)) = vntT
    End With

End Sub