Seperating Data from a cell to a row

[DA@PD]

Hello experts!

I have been building a listing of all the cars that certain parts in our
inventory fit. The format of the sheet looks like this....
Column A - Part #, Column B - Item Description, Column C - Car Models the
part fits

I started building this list by seperating the different types of models by
a comma, here is an example of line.

Part # Item Description Car Models
9Y4537 Bolt Cabrio, Golf, GTI,
Passat

Now the IS department tells me in order to load the car types into our
computer system the car types listed in Col. C have to be on their own row,
in orther words it should look like this

Part # Item Description Car Models
9Y4537 Bolt Cabrio
9Y4537 Bolt Golf
9Y4537 Bolt GTI
9Y4537 Bolt Passat

You can see my obvious delemma, as the # of parts I have is around 1000, and
the # of seperate lines I would need to create is probably in the 10's of
thousands.

Is there a way to create a VBA script that could take the data from Column C
in sheet 1 (the original list with car types seperated by commas), and on
sheet 2 seperate out the data in individual rows like I demonstrated above?

I know its unlikely, but I've put about a month's worth of work into this
project, and to do this seperation by hand would take a whole extra month.

I hope you can help!

Thanks

 

[Dave Peterson]

This may work for you:

Option Explicit
Sub testme()

Dim CurWks As Worksheet
Dim NewWks As Worksheet

Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim mySplit As Variant
Dim oRow As Long
Dim TotalRows As Long

Set CurWks = Worksheets("sheet1")
Set NewWks = Worksheets.Add

With CurWks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

oRow = 1
For iRow = FirstRow To LastRow
mySplit = Split97(Application.Substitute _
(.Cells(iRow, "C").Value, " ", ""), ",")

TotalRows = UBound(mySplit) - LBound(mySplit) + 1

NewWks.Cells(oRow, "A").Resize(TotalRows, 1).Value _
= .Cells(iRow, "A").Value

NewWks.Cells(oRow, "B").Resize(TotalRows, 1).Value _
= .Cells(iRow, "B").Value

NewWks.Cells(oRow, "C").Resize(TotalRows, 1).Value _
= Application.Transpose(mySplit)

oRow = oRow + TotalRows
Next iRow
End With
End Sub

Function Split97(sStr As String, sdelim As String) As Variant
'from Tom Ogilvy
Split97 = Evaluate("{""" & _
Application.Substitute(sStr, sdelim, """,""") & """}")
End Function