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

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