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.
<colgroup><col span="23"><col></colgroup><tbody>
</tbody>
Here is example from spreadsheet.
<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
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 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 |
| 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 |
<colgroup><col span="23"><col></colgroup><tbody>
</tbody>
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 |
<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
