Copy or duplicate rows of data based upon cell value

Question

I'm attempting to automate Excel in a way that will save me countless hours of tedious data entry. Here's my problem.

We have motorcycle parts that can fit on many different year model vehicles. The file I am working with has a list of the years in a cell. These years may or may not be consecutive. They are separated by a ",". I need a way to look at how many years are listed and duplicate the row of data that number of times.

I also need it to give only a single year for each of those rows. In the examples below the final column is FITMENT YEARS; As you can see it has 3 different years each separated by a comma. In this instance it is only 3 years it could be 10 different years or it could be just a single year.

THIS IS A SINGLE ROW OF WHAT I HAVE:

P/N Make    Mfg Model   Year Span   Fitment Years
881612  Aprilia 881965  1000 RSV4 - (SACHS) 10-12   2010, 2011, 2012

THIS IS HOW I NEED IT TO BE LISTED:

P/N Make    Mfg Model   YearSpan    Fitment Years
881612  Aprilia 881965  1000 RSV4 - (SACHS) 10-12   2010
881612  Aprilia 881965  1000 RSV4 - (SACHS) 10-12   2011
881612  Aprilia 881965  1000 RSV4 - (SACHS) 10-12   2012

I really need someone's help. I'm lost on how to proceed. Thanks

Answer 1

Try this.

Place the following routine into a standard code module and run it.

IMPORTANT: this does an in-place replacement of your data, so make sure you have a copy before running this.

Sub Jnowell()
    Dim c&, n&, v, y
    With [a2]
        c = 1
        Do
            If Len(.Item(c)) Then
                y = Split(.Item(c, 4), ", ")
                If UBound(y) Then
                    .Item(c)(2).Resize(UBound(y), 4).Insert xlDown
                    v = .Item(c).Resize(, 4)
                    .Item(c, 4) = y(0)
                    For n = 1 To UBound(y)
                        .Item(c)(n + 1).Resize(, 4) = v
                        .Item(c, 4)(n + 1) = Left$(y(0), Len(y(0)) - 4) & y(n)
                    Next
                End If
            Else
                Exit Do
            End If
            c = c + 1
        Loop
    End With
End Sub

Note: this routine assumes your data are in columns A, B, C, and D of the currently active sheet.