Excel VBA to split cell into multiple cells

Question

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.

score 1 · Accepted Answer · answered Nov 16 '17 at 20:31

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

Excel VBA to split cell into multiple cells

1 Answers1