Need a macro to duplicate rows of text based upon a cell value

Closed
jnowell
Posts
1
Registration date
Wednesday June 22, 2016
Status
Member
Last seen
June 22, 2016
- Jun 22, 2016 at 01:34 PM
Working on Mac vs. 15.17; I had a macro that use to work in a previous version of Excel. But I cannot get it to work now. I do not know VB or code. Can anyone please help me?

I have several spreadsheets that all have over 20,000 rows of data.
I need to expand the sheet based upon one of the columns.
The sheet has a column (X) of data with years separated by commas. Example: 2000, 2001, 2015
the number of years is varied.
I need a macro that will look at this cell and create duplicated rows of data based how many years exsist in the cell; Once the data is duplicated it needs to have just a single year in the (x) Column

Example:
Top row represents original row of data
Next three rows is the result I need to achieve.

cell A cell B cell C cell D cell E cell F cell G cell H cell I cell J cell K cell L cell M cell N cell O cell P cell Q cell R cell S cell T cell U cell V cell W 2000, 2001, 2015

Need the above row to give three rows of data like this:
cell A cell B cell C cell D cell E cell F cell G cell H cell I cell J cell K cell L cell M cell N cell O cell P cell Q cell R cell S cell T cell U cell V cell W 2000
cell A cell B cell C cell D cell E cell F cell G cell H cell I cell J cell K cell L cell M cell N cell O cell P cell Q cell R cell S cell T cell U cell V cell W 2001
cell A cell B cell C cell D cell E cell F cell G cell H cell I cell J cell K cell L cell M cell N cell O cell P cell Q cell R cell S cell T cell U cell V cell W 2015

Here is example from spreadsheet.

Model Object ID Section Name Item Group ID Item Group Name Make Object ID Make Name Model Name Model Years Color|Fiment Color Engine Szie Footnote Kits Required O.E.M. Position Spring Rate Model Name Path Item Object ID Item Name Item Brand Item Description Item Segment Unique Model Names Year List
1719317 Control 53762 Clutch Cable 1718762 Arctic Cat 400 DVX 04-08 /Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Arctic Cat/400 DVX 53685 414484 QuadBoss® ATV Clutch Cable ATV|UTV 400 DVX 2004, 2005, 2006, 2007, 2008
1719318 Control 53762 Clutch Cable 1718763 Can-Am DS 450 10-15 Red /Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Can-Am/DS 450 53726 414525 QuadBoss® ATV Clutch Cable ATV|UTV DS 450 2010, 2011, 2012, 2013, 2014, 2015
1719319 Control 53762 Clutch Cable 1718763 Can-Am DS 450 EFI X mx 10-12 xx /Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Can-Am/DS 450 EFI X mx 53726 414525 QuadBoss® ATV Clutch Cable ATV|UTV DS 450 X mx 2010, 2011, 2012
1719320 Control 53762 Clutch Cable 1718763 Can-Am DS 450 EFI X xc (2) 09-12 x /Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Can-Am/DS 450 EFI X xc (2) 53726 414525 QuadBoss® ATV Clutch Cable ATV|UTV DS 450 X xc 2009, 2010, 2011, 2012
1719321 Control 53762 Clutch Cable 1718763 Can-Am DS 450 STD/X 08-09 /Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Can-Am/DS 450 STD@fs:X 53726 414525 QuadBoss® ATV Clutch Cable ATV|UTV DS 450, DS 450 X 2008, 2009
1719322 Control 53762 Clutch Cable 1718763 Can-Am DS 450 X xc/X mx 2015 xx /Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Can-Am/DS 450 X xc@fs:X mx 53726 414525 QuadBoss® ATV Clutch Cable ATV|UTV DS 450 X mx, DS 450 X xc 2015
1719323 Control 53762 Clutch Cable 1718764 Honda ATC250R 1986 /Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Honda/ATC250R 53706 414505 QuadBoss® ATV Clutch Cable ATV|UTV ATC250R 1986
1719324 Control 53762 Clutch Cable 1718764 Honda ATC250R (2) 1985 /Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Honda/ATC250R (2) 53706 414505 QuadBoss® ATV Clutch Cable ATV|UTV ATC250R 1985
1719325 Control 53762 Clutch Cable 1718764 Honda ATC250R (3) 82-84 x /Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Honda/ATC250R (3) 53688 414487 QuadBoss® ATV Clutch Cable ATV|UTV ATC250R 1982, 1983, 1984


Here is the code that use to work.
Sub Split_DataPro()
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
Set Rng1 = Cells(r, "D")
Arry = Split(Trim(Rng1), ", ")
n = UBound(Arry)
If n > 0 Then
Set Rng2 = Range("A" & r & ":H" & r)
Set Rng3 = Rng2.Resize(n, 5)
Rng3.EntireRow.Insert
For c = n To 1 Step -1
Rng2.Offset(-c, 0).Value = Rng2.Value
Next c

For c = n To 0 Step -1
Rng1.Offset(-c, 0).Value = Arry(n - c)
Next c
End If




Next r
Application.ScreenUpdating = True
End Sub