Is there ability to split cells while retaining the values of adjacent columns?

Question

The IDs column in the first table contains multiple values in each cell that needs to be split. However, the unique issue is to retain both [name] and [description] info by ID into a new table.

.

The following VBA code performs the transpose paste option. This is what I am starting with to split cells with Chr(10), or new line as the delimiter:

Sub splitText()
'splits Text active cell using ALT+10 char as separator
Dim splitVals As Variant
Dim totalVals As Long

splitVals = Split(ActiveCell.Value, Chr(10))
totalVals = UBound(splitVals)
Range(Cells(ActiveCell.Row, ActiveCell.Column + 1), Cells(ActiveCell.Row, ActiveCell.Column + 1 + totalVals)).Value = splitVals

End Sub

Other than this, I am still searching for ideas.

Answer 1

Maybe this will help:

Sub splitText()
    'splits Text active cell using ALT+10 char as separator
    Dim splitVals As Variant
    Dim lngRow As Long, lngEl As Long

    With Sheet2
        'Range A2:A5
        For lngRow = 5 To 2 Step -1
            splitVals = Split(.Range("A" & lngRow).Value, Chr(10))
            'the first value
            .Range("A" & lngRow).Value = splitVals(0)
            'remaining values
            For lngEl = 1 To UBound(splitVals)
                .Rows(lngRow + lngEl).Insert
                .Range("A" & lngRow + lngEl).Value = splitVals(lngEl)
                .Range("B" & lngRow + lngEl & ":C" & lngRow + lngEl).Value = .Range("B" & lngRow & ":C" & lngRow).Value
            Next lngEl
        Next lngRow
    End With
End Sub

Change Sheet Code/Name and Range as necessary.

Before:

After:

Answer 2

It's a bit more involved than your solution because you have to insert the correct number of rows below the targeted cell and then copy the IDs and the other data into the new rows. Here's an example to help you along.

There's a little "trickery" I'm using when I calculate the offset value. I'm doing this because you can assume that all arrays from the Split function will begin indexing at 0, but my personal habit is to write code that can work with either a 0 or 1 lower bound. Calculating and using an offset makes it all work for the loops and indexes.

Option Explicit

Sub test()
    SplitText ActiveCell
End Sub

Sub SplitText(ByRef idCell As Range)
    Dim splitVals As Variant
    Dim totalVals As Long
    splitVals = Split(idCell.Value, Chr(10))
    If LBound(splitVals) = -1 Then
        '--- the split character wasn't found, so exit
        Exit Sub
    End If

    Dim offset As Long
    offset = IIf(LBound(splitVals) = 0, 1, 0)
    totalVals = UBound(splitVals) + offset

    Dim idSheet As Worksheet
    Set idSheet = idCell.Parent

    Dim idRow As Long
    idRow = idCell.Row

    '--- insert the number of rows BELOW the idCell to hold all
    '    the split values
    Dim i As Long
    For i = 1 To totalVals - 1
        idSheet.Rows(idRow + 1).Insert
    Next i

    '--- now add the IDs to all the rows and copy the other columns down
    Const TOTAL_COLUMNS As Long = 3
    Dim j As Long

    Dim startIndex As Long
    startIndex = LBound(splitVals) + offset
    For i = startIndex To totalVals
        idCell.Cells(i, 1) = splitVals(i - offset)
        For j = 2 To TOTAL_COLUMNS
            idCell.Cells(i, j) = idCell.Cells(1, j)
        Next j
    Next i
End Sub