Need to duplicate rows of data based upon values in a cell

JNowell

New Member
Joined
Jun 15, 2015
Messages
11
I'm desperate. 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 not 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 duplated 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 Acell Bcell Ccell Dcell Ecell Fcell Gcell Hcell Icell Jcell Kcell Lcell Mcell Ncell Ocell Pcell Qcell Rcell Scell Tcell Ucell Vcell W2000, 2001, 2015
cell Acell Bcell Ccell Dcell Ecell Fcell Gcell Hcell Icell Jcell Kcell Lcell Mcell Ncell Ocell Pcell Qcell Rcell Scell Tcell Ucell Vcell W2000
cell Acell Bcell Ccell Dcell Ecell Fcell Gcell Hcell Icell Jcell Kcell Lcell Mcell Ncell Ocell Pcell Qcell Rcell Scell Tcell Ucell Vcell W2001
cell Acell Bcell Ccell Dcell Ecell Fcell Gcell Hcell Icell Jcell Kcell Lcell Mcell Ncell Ocell Pcell Qcell Rcell Scell Tcell Ucell Vcell W2015

<colgroup><col span="23"><col></colgroup><tbody>
</tbody>

Here is example from spreadsheet.

Model Object IDSection NameItem Group IDItem Group NameMake Object IDMake NameModel NameModel YearsColor|FimentColorEngine SzieFootnoteKits RequiredO.E.M.PositionSpring RateModel Name PathItem Object IDItem NameItem BrandItem DescriptionItem SegmentUnique Model NamesYear List
1719317Control53762Clutch Cable1718762Arctic Cat400 DVX04-08/Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Arctic Cat/400 DVX53685414484QuadBoss®ATV Clutch Cable ATV|UTV400 DVX2004, 2005, 2006, 2007, 2008
1719318Control53762Clutch Cable1718763Can-AmDS 45010-15Red/Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Can-Am/DS 45053726414525QuadBoss®ATV Clutch Cable ATV|UTVDS 4502010, 2011, 2012, 2013, 2014, 2015
1719319Control53762Clutch Cable1718763Can-AmDS 450 EFI X mx10-12xx/Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Can-Am/DS 450 EFI X mx53726414525QuadBoss®ATV Clutch Cable ATV|UTVDS 450 X mx2010, 2011, 2012
1719320Control53762Clutch Cable1718763Can-AmDS 450 EFI X xc (2)09-12x/Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Can-Am/DS 450 EFI X xc (2)53726414525QuadBoss®ATV Clutch Cable ATV|UTVDS 450 X xc2009, 2010, 2011, 2012
1719321Control53762Clutch Cable1718763Can-AmDS 450 STD/X08-09/Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Can-Am/DS 450 STD@fs:X53726414525QuadBoss®ATV Clutch Cable ATV|UTVDS 450, DS 450 X2008, 2009
1719322Control53762Clutch Cable1718763Can-AmDS 450 X xc/X mx2015xx/Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Can-Am/DS 450 X xc@fs:X mx53726414525QuadBoss®ATV Clutch Cable ATV|UTVDS 450 X mx, DS 450 X xc2015
1719323Control53762Clutch Cable1718764HondaATC250R1986/Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Honda/ATC250R53706414505QuadBoss®ATV Clutch Cable ATV|UTVATC250R1986
1719324Control53762Clutch Cable1718764HondaATC250R (2)1985/Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Honda/ATC250R (2)53706414505QuadBoss®ATV Clutch Cable ATV|UTVATC250R1985
1719325Control53762Clutch Cable1718764HondaATC250R (3)82-84x/Structures/Publication/Cat_QuadBoss/Control/Cable Assemblies/Clutch Cable/Honda/ATC250R (3)53688414487QuadBoss®ATV Clutch Cable ATV|UTVATC250R1982, 1983, 1984

<colgroup><col span="8"><col span="8"><col span="6"><col><col></colgroup><tbody>
</tbody>


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
 

Some videos you may like

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

Watch MrExcel Video

Forum statistics

Threads
1,127,205
Messages
5,623,363
Members
415,969
Latest member
Rey99

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top