Excel VBA to split cell into multiple cells [duplicate] - vba

Question

This question already has answers here:
Split cell values into multiple rows and keep other data
(5 answers)
Create new Excel rows based on column data
(4 answers)
Macro to TRANSPOSE comma delimited cell into rows and copy down adjacent cells [closed]
(1 answer)
Closed 5 years ago.
Good afternoon,
I am having a big issue in my quest to learn VBA. Currently, my data is (as below) in a structure that sometimes contains multiple serial numbers belonging to a single part.
I have a VBA macro that I wrote which imports this data and formats it appropriately for a separate program. However, I am working on a sub that will allow me to go through and separate these serial numbers that are delimited by a comma.
For example:
But, I want it to look like this:
I found some code on this site (Split Cells Into Multiple Rows using Vb Code) which has helped, but I am having trouble with it: Here is what I have
Sub SplitSerial()
Dim SN As String
Dim i As Integer
Dim numArray()
SN = ActiveCell.Value
numArray = Split(SN, " ")
For LBound(numArray) To UBound(numArray)
Cells(1, i + 1).Value = numArray(i)
MsgBox numArray(i)
Next i
End Sub
The problem is, this spreadsheet can get pretty large (5,000+) rows, so I don't know how to have it loop through the column, and if it has a ",', split the serial numbers but copy the values from the remaining cells.
Any guidance, advice, or coaching would be greatly appreciated. I am trying very hard to learn VBA.

Answer 1

Try this, which uses arrays so should speed things up. Have added some comments to briefly explain what the code is doing.
Sub x()
Dim v, vOut(), i As Long, j As Long, k As Long, w
v = Sheet1.Range("A1").CurrentRegion.Value 'assumes starting data in A1 of sheet1
ReDim vOut(1 To UBound(v, 1) * 10, 1 To 3) 'output array, assumes no more than 10 serial numbers for each part
For i = LBound(v, 1) To UBound(v, 1)
w = Split(v(i, 2), ",") 'split serial number by comma
For j = LBound(w) To UBound(w) 'for each serial number
k = k + 1
vOut(k, 1) = v(i, 1) 'repeat part number
vOut(k, 2) = w(j) 'add particular serial number
vOut(k, 3) = v(i, 3) 'repeat price
Next j
Next i
Sheet2.Range("A1").Resize(k, 3) = vOut 'output to A1 of sheet2.
End Sub