Re-Configure, duplicate and restructure data set into a new format. Seems complex but Im sure there is a way.

shortjake

New Member
Joined
Jun 29, 2016
Messages
21
Hi Excel Gurus!

I am in need of some big-time help.

I have received some data that is very close to the format I need but still needs quite a bit of work.
I have a range of vehicles (make/model/year) and SKU's (products) that fit those models. I need the format to be completely changed so that my stock system and website tool can bulk upload the data in the required format.

Data came like this:

Column 1 - MAKE/MODEL/YEAR (seperated by slashes / )
Column 2 - SKU# seperated by a comma.

I need the data to be:

Column 1 - SKU#
Column 2 - Make
Column 3 - Model
Column 4 - Year

However trickey part is that rather than the skus that fit said vehicle be listed horizontally, the skus need to be listed vertically and the vehicle repeated vertically, but also the SKU could fit multiple vehicles, so the SKU also needs to be repeated.

Please see how the data is now vs how it needs to be (I did the "needs to be" manually) Obviously it can be done all manually but will take a very long time given the amount of SKU's and vehicles

So far I have learned to turn the data into a table and used text to column to split everything up. Which is step one. But now I am stuck.



trackpro_makemodelyear.csv
ABCDEFGHIJKLMN
1Column1Column2Needs to be like this
2categoryrelated_skusPartMake ModelYear
3Aprilia/Caponord 1200/2013EVO007BL,EVO007CL,JPMJ001-03,PRO007BL,PRO007CLHB150CApriliaCaponord ETV 10002001
4Aprilia/Caponord 1200/2014EVO007BL,EVO007CL,JPMJ001-03,PRO007BL,PRO007CLHB150CApriliaCaponord ETV 10002002
5Aprilia/Caponord 1200/2015EVO007BL,EVO007CL,JPMJ001-03,PRO007BL,PRO007CLHB150CApriliaCaponord ETV 10002003
6Aprilia/Caponord 1200/2016EVO007BL,EVO007CL,JPMJ001-03,PRO007BL,PRO007CLHB150CApriliaCaponord ETV 10002004
7Aprilia/Caponord ETV 1000/2001HB150C,JPMJ004-10HB150CApriliaCaponord ETV 10002005
8Aprilia/Caponord ETV 1000/2002HB150C,JPMJ004-10HB150CApriliaCaponord ETV 10002006
9Aprilia/Caponord ETV 1000/2003HB150C,JPMJ004-10HB150CApriliaCaponord ETV 10002007
10Aprilia/Caponord ETV 1000/2004HB150C,JPMJ004-10JPMJ004-10ApriliaCaponord ETV 10002001
11Aprilia/Caponord ETV 1000/2005HB150C,JPMJ004-10JPMJ004-10ApriliaCaponord ETV 10002002
12Aprilia/Caponord ETV 1000/2006HB150C,JPMJ004-10JPMJ004-10ApriliaCaponord ETV 10002003
13Aprilia/Caponord ETV 1000/2007HB150C,JPMJ004-10JPMJ004-10ApriliaCaponord ETV 10002004
14Aprilia/Caponord ETV 1000/2008JPMJ004-10JPMJ004-10ApriliaCaponord ETV 10002005
15Aprilia/Caponord ETV 1000/2009JPMJ004-10JPMJ004-10ApriliaCaponord ETV 10002006
16Aprilia/Caponord ETV 1000/2010JPMJ004-10JPMJ004-10ApriliaCaponord ETV 10002007
17Aprilia/Caponord ETV 1000/2011JPMJ004-10JPMJ004-10ApriliaCaponord ETV 10002008
18Aprilia/Caponord ETV 1000/2013JPMJ001-03JPMJ004-10ApriliaCaponord ETV 10002009
19Aprilia/Caponord ETV 1000/2014JPMJ001-03JPMJ004-10ApriliaCaponord ETV 10002010
20Aprilia/Caponord ETV 1000/2015JPMJ001-03JPMJ004-10ApriliaCaponord ETV 10002011
21Aprilia/Caponord ETV 1000/2016JPMJ001-03JPMJ004-10ApriliaCaponord ETV 10002013
22Aprilia/Dorsoduro 1200/2010DASHAPR001,JPMJ001-01JPMJ004-10ApriliaCaponord ETV 10002014
23Aprilia/Dorsoduro 1200/2011DASHAPR001,JPMJ001-01JPMJ004-10ApriliaCaponord ETV 10002015
24Aprilia/Dorsoduro 1200/2012DASHAPR001,JPMJ001-01JPMJ004-10ApriliaCaponord ETV 10002016
25Aprilia/Dorsoduro 1200/2013DASHAPR001,JPMJ001-01
26Aprilia/Dorsoduro 750/2008DASHAPR001,JPMJ001-01,PM108S
27Aprilia/Dorsoduro 750/2009DASHAPR001,JPMJ001-01,PM108S
28Aprilia/Dorsoduro 750/2010DASHAPR001,JPMJ001-01,PM108S
29Aprilia/Dorsoduro 750/2011DASHAPR001,JPMJ001-01,PM108S
30Aprilia/Dorsoduro 750/2012DASHAPR001,JPMJ001-01,PM108S
31Aprilia/Dorsoduro 750/2013DASHAPR001,JPMJ001-01,PM108S
32Aprilia/Dorsoduro 750/2014DASHAPR001,JPMJ001-01,PM108SText to CoumnsColumn2
33Aprilia/Dorsoduro 750/2015DASHAPR001,JPMJ001-01,PM108SMake ModelYearSkuSkuSkuSkuSkuSkuSku
34Aprilia/Dorsoduro 750/2016DASHAPR001,JPMJ001-01,PM108SApriliaCaponord 12002013EVO007BLEVO007CLJPMJ001-03PRO007BLPRO007CL
35Aprilia/Dorsoduro 900/2017DASHAPR006,JPMJ001-01,PM108SApriliaCaponord 12002014EVO007BLEVO007CLJPMJ001-03PRO007BLPRO007CL
36Aprilia/Dorsoduro 900/2018DASHAPR006,JPMJ001-01,PM108SApriliaCaponord 12002015EVO007BLEVO007CLJPMJ001-03PRO007BLPRO007CL
37Aprilia/Dorsoduro 900/2019DASHAPR006,PM108SApriliaCaponord 12002016EVO007BLEVO007CLJPMJ001-03PRO007BLPRO007CL
38Aprilia/Dorsoduro 900/2020DASHAPR006,PM108SApriliaCaponord ETV 10002001HB150CJPMJ004-10
39Aprilia/RS660/2021BA12-6-GBR-SET,CGA09-GBR,DASHAPR012,EC-RS660-2021-1-GBR,EC-RS660-2021-2-GBR,EC-RS660-2021-5-GBR,EC-RS660-2021-SET-GBR,EVO009BL,EVO009CL,GUARDAPR007,GUARDAPR007M,JPPLD660,JPPLDR660,JPPLR660,JPPLSR660,PM176S,PM176S-WP,PM176SF1-85,PRO009BL,PRO009CLApriliaCaponord ETV 10002002HB150CJPMJ004-10
40Aprilia/RST Futura/2001ApriliaCaponord ETV 10002003HB150CJPMJ004-10
41Aprilia/RST Futura/2002ApriliaCaponord ETV 10002004HB150CJPMJ004-10
42Aprilia/RST Futura/2003ApriliaCaponord ETV 10002005HB150CJPMJ004-10
43Aprilia/RSV 1000 R Factory/2004EVO001BL,EVO001CL,PRO001BL,PRO001CLApriliaCaponord ETV 10002006HB150CJPMJ004-10
44Aprilia/RSV 1000 R Factory/2005EVO001BL,EVO001CL,FC102B,FC102G,FC102N,FC102R,FC102S,FC102Y,PM05S,PM05SF1-85,PRO001BL,PRO001CLApriliaCaponord ETV 10002007HB150CJPMJ004-10
45Aprilia/RSV 1000 R Factory/2006EVO001BL,EVO001CL,FC102B,FC102G,FC102N,FC102R,FC102S,FC102Y,PM05S,PM05SF1-85,PRO001BL,PRO001CLApriliaCaponord ETV 10002008JPMJ004-10
46Aprilia/RSV 1000 R Factory/2007EVO001BL,EVO001CL,FC102B,FC102G,FC102N,FC102R,FC102S,FC102Y,PM05S,PM05SF1-85,PRO001BL,PRO001CLApriliaCaponord ETV 10002009JPMJ004-10
47Aprilia/RSV 1000 R Factory/2008EVO001BL,EVO001CL,FC102B,FC102G,FC102N,FC102R,FC102S,FC102Y,PM05S,PM05SF1-85,PRO001BL,PRO001CLApriliaCaponord ETV 10002010JPMJ004-10
48Aprilia/RSV 1000 R Factory/2009EVO001BL,EVO001CL,FC102B,FC102G,FC102N,FC102R,FC102S,FC102Y,PM05S,PM05SF1-85,PRO001BL,PRO001CLApriliaCaponord ETV 10002011JPMJ004-10
49Aprilia/RSV 1000 R Factory/2010EVO001BL,EVO001CL,PM05S,PM05SF1-85,PRO001BL,PRO001CLApriliaCaponord ETV 10002013JPMJ001-03
50Aprilia/RSV Mille/1998CJP112H-01,JPMJ011-01ApriliaCaponord ETV 10002014JPMJ001-03
51Aprilia/RSV Mille/1999CJP112H-01,JPMJ011-01ApriliaCaponord ETV 10002015JPMJ001-03
52Aprilia/RSV Mille/2000CJP112H-01,JPMJ011-01,PM05S,PM05SF1-85ApriliaCaponord ETV 10002016JPMJ001-03
53Aprilia/RSV Mille/2001CJP112H-01,JPMJ011-01ApriliaDorsoduro 12002010DASHAPR001JPMJ001-01
54Aprilia/RSV Mille/2002CJP112H-01,JPMJ011-01ApriliaDorsoduro 12002011DASHAPR001JPMJ001-01
55Aprilia/RSV Mille/2003CJP112H-01,JPMJ011-01ApriliaDorsoduro 12002012DASHAPR001JPMJ001-01
56Aprilia/RSV Tuono/2002CJP112H-01,JPMJ011-01ApriliaDorsoduro 12002013DASHAPR001JPMJ001-01
57Aprilia/RSV Tuono/2003CJP112H-01,JPMJ011-01ApriliaDorsoduro 7502008DASHAPR001JPMJ001-01PM108S
58Aprilia/RSV Tuono/2004CJP112H-01,JPMJ011-01ApriliaDorsoduro 7502009DASHAPR001JPMJ001-01PM108S
59Aprilia/RSV Tuono/2005CJP112H-01,JPMJ011-01ApriliaDorsoduro 7502010DASHAPR001JPMJ001-01PM108S
60Aprilia/RSV4 1100 Factory/2019BA12-6-RSV4-GBR-SET,CJP014R-01,CP-RSV4-2010-CS-GBR,DASHAPR006,DKS032N,EC-RSV4-2010-1-GBR,EC-RSV4-2010-2-GBR,EC-RSV4-2010-SET-GBR,EVO002BL,EVO002CL,FC102B,FC102G,FC102N,FC102R,FC102S,FC102Y,FS-RSV4-2010-R,JPACC009,JPACC009RV,JPBRDX,JPKS009,JPMJ001-20,JPPLD009,JPPLR009RF,JPPLRB009RF,JPPLSR009RF,PM147S,PM147SF1-85,PRO002BL,PRO002CLApriliaDorsoduro 7502011DASHAPR001JPMJ001-01PM108S
61Aprilia/RSV4 1100 Factory/2020BA12-6-RSV4-GBR-SET,CJP014R-01,CP-RSV4-2010-CS-GBR,DASHAPR006,DKS032N,EC-RSV4-2010-1-GBR,EC-RSV4-2010-2-GBR,EC-RSV4-2010-SET-GBR,EVO002BL,EVO002CL,FC102B,FC102G,FC102N,FC102R,FC102S,FC102Y,FS-RSV4-2010-R,JPACC009,JPACC009RV,JPBRDX,JPKS009,JPMJ001-20,JPPLD009,JPPLR009RF,JPPLRB009RF,JPPLSR009RF,PM147S,PM147SF1-85,PRO002BL,PRO002CLApriliaDorsoduro 7502012DASHAPR001JPMJ001-01PM108S
62Aprilia/RSV4 1100 Factory/2021BA12-6-RSV4-GBR-SET,CPM-3,DASHAPR013,DKS032N,EC-RSV4-2010-2-GBR,EC-RSV4-2021-1-GBR,EC-RSV4-2021-SET-GBR,EVO010BL,EVO010CL,FS-RSV4-2010-R,GUARDAPR005,GUARDAPR005M,PM147S,PM147SF1-85,PRO010BL,PRO010CLApriliaDorsoduro 7502013DASHAPR001JPMJ001-01PM108S
63Aprilia/RSV4 Factory APRC/2009BA12-6-RSV4-GBR-SET,CJP014R-01,CP-RSV4-2010-CS-GBR,CPM-3,DASHAPR001,EC-RSV4-2010-1-GBR,EC-RSV4-2010-2-GBR,EC-RSV4-2010-SET-GBR,EVO002BL,EVO002CL,FC102B,FC102G,FC102N,FC102R,FC102S,FC102Y,FS-RSV4-2010-R,FT002N,FT002R,JPBRDX,JPMJ001-20,JPPL009,JPPLD009,JPPLDB009,JPPLR009,JPPLRB009,JPPLS009,JPPLSR009,PM94S,PRO002BL,PRO002CLApriliaDorsoduro 7502014DASHAPR001JPMJ001-01PM108S
64Aprilia/RSV4 Factory APRC/2010BA12-6-RSV4-GBR-SET,CJP014R-01,CP-RSV4-2010-CS-GBR,CPM-3,DASHAPR001,EC-RSV4-2010-1-GBR,EC-RSV4-2010-2-GBR,EC-RSV4-2010-SET-GBR,EVO002BL,EVO002CL,FC102B,FC102G,FC102N,FC102R,FC102S,FC102Y,FS-RSV4-2010-R,FT002N,FT002R,JPBRDX,JPKS009,JPMJ001-20,JPPL009,JPPLD009,JPPLDB009,JPPLR009,JPPLRB009,JPPLS009,JPPLSR009,PM94S,PRO002BL,PRO002CLApriliaDorsoduro 7502015DASHAPR001JPMJ001-01PM108S
65Aprilia/RSV4 Factory APRC/2011BA12-6-RSV4-GBR-SET,CJP014R-01,CP-RSV4-2010-CS-GBR,CPM-3,DASHAPR001,EC-RSV4-2010-1-GBR,EC-RSV4-2010-2-GBR,EC-RSV4-2010-SET-GBR,EVO002BL,EVO002CL,FC102B,FC102G,FC102N,FC102R,FC102S,FC102Y,FS-RSV4-2010-R,FT002N,FT002R,JPBRDX,JPKS009,JPMJ001-20,JPPL009,JPPLD009,JPPLDB009,JPPLR009TC,JPPLRB009TC,JPPLS009,JPPLSR009TC,PM94S,PRO002BL,PRO002CLApriliaDorsoduro 7502016DASHAPR001JPMJ001-01PM108S
66Aprilia/RSV4 Factory APRC/2012BA12-6-RSV4-GBR-SET,CJP014R-01,CP-RSV4-2010-CS-GBR,CPM-3,DASHAPR001,EC-RSV4-2010-1-GBR,EC-RSV4-2010-2-GBR,EC-RSV4-2010-SET-GBR,EVO002BL,EVO002CL,FC102B,FC102G,FC102N,FC102R,FC102S,FC102Y,FS-RSV4-2010-R,FT002N,FT002R,JPBRDX,JPKS009,JPMJ001-20,JPPL009,JPPLD009,JPPLDB009,JPPLR009TC,JPPLRB009TC,JPPLS009,JPPLSR009TC,PM94S,PRO002BL,PRO002CLApriliaDorsoduro 9002017DASHAPR006JPMJ001-01PM108S
67Aprilia/RSV4 Factory APRC/2013BA12-6-RSV4-GBR-SET,CJP014R-01,CP-RSV4-2010-CS-GBR,CPM-3,DASHAPR001,EC-RSV4-2010-1-GBR,EC-RSV4-2010-2-GBR,EC-RSV4-2010-SET-GBR,EVO002BL,EVO002CL,FC102B,FC102G,FC102N,FC102R,FC102S,FC102Y,FS-RSV4-2010-R,FT002N,FT002R,JPBRDX,JPKS009,JPMJ001-20,JPPL009,JPPLD009,JPPLDB009,JPPLR009TC,JPPLRB009TC,JPPLS009,JPPLSR009TC,PM94S,PRO002BL,PRO002CLApriliaDorsoduro 9002018DASHAPR006JPMJ001-01PM108S
trackpro_makemodelyear
 
D


Hi mate, Do you mean run this macro after you have done text to columns? Will is take into consideration the output could be well over 100000 rows?

Cheers
No, simply run the code. The code includes the text to columns process.
 
Upvote 0

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
I had problems when I tried to rerun this code today. I've made some amendments and the code below seems to work now.

VBA Code:
Option Explicit
Sub shortjake_2()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    
    Dim rng As Range, rng1 As Range, rng2 As Range
    Set rng1 = ws1.Range("A3", ws1.Cells(Rows.Count, "A").End(xlUp))
    Set rng2 = ws1.Range("B3", ws1.Cells(Rows.Count, "B").End(xlUp))
    
    Dim lRow As Long, lCol1 As Long, lCol2 As Long, lCol3 As Long
    lCol1 = ws1.Cells.Find("*", , xlFormulas, , 2, 2).Column + 2
    lCol2 = lCol1 + 3
    
    Set rng = ws1.Range("A1").CurrentRegion
    rng.Value = Application.Trim(rng)
    
    Application.DisplayAlerts = False
    rng1.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
        TrailingMinusNumbers:=True
    rng2.TextToColumns ws1.Cells(1, lCol2), 1, 1, , , , , , , ","
    Application.DisplayAlerts = True
    
    lRow = ws1.Cells(Rows.Count, lCol1).End(xlUp).Row
    lCol3 = ws1.Cells.Find("*", , xlFormulas, , 2, 2).Column
    
    Dim model, sku, arrOut
    model = ws1.Range(ws1.Cells(1, lCol1), ws1.Cells(lRow, lCol1 + 2))
    sku = ws1.Range(ws1.Cells(1, lCol2), ws1.Cells(lRow, lCol3))
    ReDim arrOut(1 To lRow, 1 To 4)
    
    Dim i As Long, j As Long
    
    For i = 1 To UBound(sku, 1)
        For j = 1 To UBound(sku, 2)
            If IsEmpty(sku(i, 1)) Then Exit For
            If Not IsEmpty(sku(i, j)) Then
                arrOut(i, 1) = sku(i, j)
                arrOut(i, 2) = model(i, 1)
                arrOut(i, 3) = model(i, 2)
                arrOut(i, 4) = model(i, 3)
            End If
        Next j
        ws2.Cells(2, 1).Resize(lRow, 4).Value = arrOut
    Next i
    
    ws2.Range("a1").Resize(, 4) = Array("Part", "Make", "Model", "Year")
    ws1.Range(ws1.Cells(1, lCol1), ws1.Cells(1, lCol3)).EntireColumn.Delete
    
    With ws2
        .Range("A1").Resize(, 4) = Array("Part", "Make", "Model", "Year")
        .Range("A:D").Columns.AutoFit
        .Range("A1:D1").Font.Bold = True
    End With
    
    With ws2.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A1"), Order:=xlAscending
        .SortFields.Add Key:=Range("B1"), Order:=xlAscending
        .SortFields.Add Key:=Range("C1"), Order:=xlAscending
        .SortFields.Add Key:=Range("D1"), Order:=xlAscending
        .SetRange Range("A2:D" & lRow + 1)
        .Apply
    End With
End Sub
 
Upvote 0
DO you think it will work on this? Similar situation?

20220820 ALL MODELS W APPLIC EXP XLSX.xlsx
ABCDEFGHIJKLMNOPQRSTUVWXYZAAABACADAEAFAGAHAIAJAKALAMANAOAPAQARASATAUAVAWAXAYAZBABBBCBDBEBFBGBHBIBJBKBLBMBNBOBPBQBRBSBTBUBVBWBXBYBZCACBCCCDCECFCGCHCICJCKCLCMCNCOCPCQCRCSCTCUCVCWCXCYCZDADBDCDDDEDFDGDHDIDJDKDLDMDNDODPDQDRDSDTDUDVDWDXDYDZEAEBECEDEEEFEGEHEIEJEKELEMENEOEPEQERESETEUEVEWEXEYEZFAFBFCFDFEFFFGFHFIFJFKFLFMFNFOFPFQFRFSFTFUFVFWFXFYFZGAGBGCGDGEGFGGGHGIGJGKGLGMGNGOGPGQGRGSGTGUGVGWGXGYGZHAHBHCHDHEHFHG
1ModelIDMakeModel NameModel CodeModel YearChain - OE SizeFront SprocketRear Sprocket - AlloyRear Sprocket - SteelRear Sprocket - Steel HybridRK Chain - Optional 420RK Chain - Optional 428RK Chain - Optional 520RK Chain - Optional 525RK Chain - Optional 530Sprocket Front - Optional 420Sprocket Front - Optional 428Sprocket Front - Optional 520Sprocket Front - Optional 525Sprocket Front - Optional 530Sprocket Front - VORTEX 420Sprocket Front - VORTEX 428Sprocket Front - VORTEX 520Sprocket Front - VORTEX 525Sprocket Front - VORTEX 530Sprocket Rear - Optional 428Sprocket Rear - Optional 520Sprocket Rear - Optional 525Sprocket Rear - Optional 530Sprocket Rear - Spr Ducati AdaptorSprocket Rear - VORTEX 420Sprocket Rear - VORTEX 428Sprocket Rear - VORTEX 520Sprocket Rear - VORTEX 525Sprocket Rear - VORTEX 530Sprocket Rear RK - AlloySprockets & Chain KitsSprockets & Chain Kits - Optional FERODO Brake FrontFERODO Brake Front - OptionalFERODO Brake RearFERODO Brake Rear - OptionalFERODO Front DiscFERODO Rear DiscFERODO Sidecar or Parking BrakeMaxum-Tech Front Brake PadsMaxum-Tech Rear Brake PadsSMX Disc Bolt Kits - FrontSMX Disc Bolt Kits - RearStates MX Front Disc - OversizeStates MX Front Disc - Race WaveStates MX Rear Disc - Race WaveCam ChainClutch Fibre PlatesClutch Fibre Plates HPClutch Plate KitsClutch Plate Kits HPClutch SpringsAir Filter - BMCAir Filter - BMC RaceAir Filter - CHAMPIONAir Filter KitAir Filter- HIFLOMaintenance - Filter CareOil Change KitOil Filter (secondary) - CHAMPIONOil Filter (secondary) - HIFLOOil Filter (Transmission) - CHAMPIONOil Filter (Transmission) - HIFLOOil Filter - CHAMPIONOil Filter - HIFLOOil Filter - HIFLO Optional Long Race FilterDYNAVOLT - BatteryMOTOCELL GOLD - Lithium BatteryROADSTAR - BatteryBEARING WORX - Hub Repair Kit - FrontBEARING WORX - Hub Repair Kit - RearBEARING WORX - Linkage KitBEARING WORX - Shock Mount Lower KitBEARING WORX - Shock Mount Upper KitBEARING WORX - Steering Bearing KitBEARING WORX - Swingarm KitBEARING WORX - Wheel Kit - FrontBEARING WORX - Wheel Kit - RearLINK - Steering KitLINK - Wheel FrontLINK - Wheel L/H RearLINK - Wheel R/H RearLINK - Wheel Sprocket CarrierFork Seal SetSeal - ARIETESeal - LINKSeal DustTelelever BootTube Bush - InnerTube Bush - OuterPIRELLI Front TyresPIRELLI Rear TyresVEE RUBBER Front TyresVEE RUBBER Rear TyresRim STATES MX - FrontRim STATES MX - RearSpoke Set - FrontSpoke Set - RearSTATES MX - Front WheelSTATES MX - Rear WheelSTATES MX - Rear Wheel - Optional SizeSTATES MX - Wheel Hub FrontSTATES MX - Wheel Hub RearSTATES MX - Wheel SetsPOLISPORT Air BoxPOLISPORT Airbox CoverPOLISPORT Alternator CoverPOLISPORT Bottom Fork ProtectorPOLISPORT Chain Guide and Slider KitPOLISPORT Chain GuidesPOLISPORT Chain SlidersPOLISPORT Chain Sliding PiecePOLISPORT Clutch and Alt Cover KitPOLISPORT Clutch Cover ProtectorPOLISPORT Disc and Bottom Fork ProtectorsPOLISPORT Disc Protector - RearPOLISPORT Fender - FrontPOLISPORT Fender - RearPOLISPORT Filter AirboxPOLISPORT Fork GuardsPOLISPORT Frame GuardsPOLISPORT Front Number PlatePOLISPORT Headlight SurroundPOLISPORT Ignition Cover ProtectorPOLISPORT Perf. Chain Guide Wear PadPOLISPORT Performance Chain GuidePOLISPORT Rad Scoops - LowerPOLISPORT Rad Scoops - UpperPOLISPORT Radiator Louvre MeshPOLISPORT Radiator LouvresPOLISPORT Radiator ScoopsPOLISPORT Shock FlapPOLISPORT Side Cover - LowerPOLISPORT Side Cover - UpperPOLISPORT Side CoversPOLISPORT Skid Plate/GaurdPOLISPORT Sprocket CoverPOLISPORT Swingarm ProtectorsPOLISPORT Tank CoversPOLISPORT Water Pump GuardKEITI Body Parts Fastener SetLA CORSA Lever SetsSMX Axle BlocksSMX Bar EndsSMX Billet KitsSMX Brake Lever - FlexSMX Brake Lever - Fold & FlexSMX Brake PedalsSMX Case SaversSMX Clutch Lever & Perch FlexSMX Clutch Lever & Perch Fold & FlexSMX Clutch Lever & Perch Quick AdjustSMX Clutch Lever F & F States & OEMSMX Clutch Levers Flex StatesMX and OEMSMX FootpegsSMX Front Brake Line ClampSMX Gear Lever AlloySMX Hour MetersSMX Kickstart Lever AlloySMX Launch ControlsSMX Pro Pack Bolt KitsSMX Rear Brake ClevisSMX Rotator ClampSMX Tank CapsSMX Track Pack Bolt KItsVORTEX Clip-OnsVORTEX Fuel Cap BaseVORTEX Fuel Cap ClickersVORTEX Fuel CapsVORTEX Lowering LinksVORTEX RearsetsARROW AccessoriesARROW CollectorsARROW DB KillerARROW Full SystemARROW Mid-PipeARROW SilencerARROW Silencer + Mid-PipePOLISPORT - Complete KitsPOLISPORT - Restyle Kits2 Stroke OilChain CareEngine OilEquipment CareFinal Drive OilFork Oil Front Diff OilMechanical CareOil Change KitsPaint Plastic and Metal CarePrimary Drive OilTransmission OilPOLISPORT - Graphic GuardPOLISPORT - Lever Set (Brake & Clutch)POLISPORT - Pipe GuardPOLISPORT - SeatPOLISPORT - Seat Cover - SparePOLISPORT Restyle - Airbox CoverPOLISPORT Restyle - Fender FrontPOLISPORT Restyle - Fender RearPOLISPORT Restyle - Number PlatePOLISPORT Restyle - Radiator ScoopsPOLISPORT Restyle - Side CoversARISUN ATV Front TyresARISUN ATV Rear TyresARACHNID Front TyreARACHNID Rear TyreTube FrontTube Rear
280370ADLYNifty 50HH201761-276-97 61-276-98 61-292-5461-276-97 61-277-09 61-292-5416-705-00 16-709-00 16-710-00 16-729-00 16-731-00 26-705-01 26-705-02 26-705-05 26-705-07 26-710-07 26-730-0016-717-00 16-719-00 16-720-00 16-721-00 16-722-00 26-718-01 26-719-01 26-720-01 26-721-03 26-722-01 26-732-0016-701-00 16-703-00 16-707-00 16-711-00 26-701-07 26-703-02 26-703-07 26-707-02 26-711-0716-702-00 16-702-00T 16-712-00 16-712-00T 16-724-00 16-726-00 16-727-00 16-734-00 26-702-02 26-702-07
383852ADLYInterceptor 150SATV201616-705-00 16-709-00 16-710-00 16-729-00 16-731-00 26-705-01 26-705-02 26-705-05 26-705-07 26-710-07 26-730-0016-717-00 16-719-00 16-720-00 16-721-00 16-722-00 26-718-01 26-719-01 26-720-01 26-721-03 26-722-01 26-732-0016-701-00 16-703-00 16-707-00 16-711-00 26-701-07 26-703-02 26-703-07 26-707-02 26-711-0716-702-00 16-702-00T 16-712-00 16-712-00T 16-724-00 16-726-00 16-727-00 16-734-00 26-702-02 26-702-0776-105-01 76-215-02
483851ADLY500SATV201216-705-00 16-709-00 16-710-00 16-729-00 16-731-00 26-705-01 26-705-02 26-705-05 26-705-07 26-710-07 26-730-0016-717-00 16-719-00 16-720-00 16-721-00 16-722-00 26-718-01 26-719-01 26-720-01 26-721-03 26-722-01 26-732-0016-701-00 16-703-00 16-707-00 16-711-00 26-701-07 26-703-02 26-703-07 26-707-02 26-711-0716-702-00 16-702-00T 16-712-00 16-712-00T 16-724-00 16-726-00 16-727-00 16-734-00 26-702-02 26-702-0776-105-0476-106-01 76-216-05
583849ADLY600UATV201116-705-00 16-709-00 16-710-00 16-729-00 16-731-00 26-705-01 26-705-02 26-705-05 26-705-07 26-710-07 26-730-0016-717-00 16-719-00 16-720-00 16-721-00 16-722-00 26-718-01 26-719-01 26-720-01 26-721-03 26-722-01 26-732-0016-701-00 16-703-00 16-707-00 16-711-00 26-701-07 26-703-02 26-703-07 26-707-02 26-711-0716-702-00 16-702-00T 16-712-00 16-712-00T 16-724-00 16-726-00 16-727-00 16-734-00 26-702-02 26-702-0776-111-01 76-168-01 76-212-11 76-233-01 76-235-01 76-236-01 76-26A-0376-111-02 76-168-02 76-212-13 76-233-02 76-235-02 76-236-02 76-26A-04
683850ADLY600UATV201216-705-00 16-709-00 16-710-00 16-729-00 16-731-00 26-705-01 26-705-02 26-705-05 26-705-07 26-710-07 26-730-0016-717-00 16-719-00 16-720-00 16-721-00 16-722-00 26-718-01 26-719-01 26-720-01 26-721-03 26-722-01 26-732-0016-701-00 16-703-00 16-707-00 16-711-00 26-701-07 26-703-02 26-703-07 26-707-02 26-711-0716-702-00 16-702-00T 16-712-00 16-712-00T 16-724-00 16-726-00 16-727-00 16-734-00 26-702-02 26-702-0776-111-01 76-168-01 76-212-11 76-233-01 76-235-01 76-236-01 76-26A-0376-111-02 76-168-02 76-212-13 76-233-02 76-235-02 76-236-02 76-26A-04
Sheet1
 
Upvote 0
Hi
I had problems when I tried to rerun this code today. I've made some amendments and the code below seems to work now.

VBA Code:
Option Explicit
Sub shortjake_2()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
   
    Dim rng As Range, rng1 As Range, rng2 As Range
    Set rng1 = ws1.Range("A3", ws1.Cells(Rows.Count, "A").End(xlUp))
    Set rng2 = ws1.Range("B3", ws1.Cells(Rows.Count, "B").End(xlUp))
   
    Dim lRow As Long, lCol1 As Long, lCol2 As Long, lCol3 As Long
    lCol1 = ws1.Cells.Find("*", , xlFormulas, , 2, 2).Column + 2
    lCol2 = lCol1 + 3
   
    Set rng = ws1.Range("A1").CurrentRegion
    rng.Value = Application.Trim(rng)
   
    Application.DisplayAlerts = False
    rng1.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
        TrailingMinusNumbers:=True
    rng2.TextToColumns ws1.Cells(1, lCol2), 1, 1, , , , , , , ","
    Application.DisplayAlerts = True
   
    lRow = ws1.Cells(Rows.Count, lCol1).End(xlUp).Row
    lCol3 = ws1.Cells.Find("*", , xlFormulas, , 2, 2).Column
   
    Dim model, sku, arrOut
    model = ws1.Range(ws1.Cells(1, lCol1), ws1.Cells(lRow, lCol1 + 2))
    sku = ws1.Range(ws1.Cells(1, lCol2), ws1.Cells(lRow, lCol3))
    ReDim arrOut(1 To lRow, 1 To 4)
   
    Dim i As Long, j As Long
   
    For i = 1 To UBound(sku, 1)
        For j = 1 To UBound(sku, 2)
            If IsEmpty(sku(i, 1)) Then Exit For
            If Not IsEmpty(sku(i, j)) Then
                arrOut(i, 1) = sku(i, j)
                arrOut(i, 2) = model(i, 1)
                arrOut(i, 3) = model(i, 2)
                arrOut(i, 4) = model(i, 3)
            End If
        Next j
        ws2.Cells(2, 1).Resize(lRow, 4).Value = arrOut
    Next i
   
    ws2.Range("a1").Resize(, 4) = Array("Part", "Make", "Model", "Year")
    ws1.Range(ws1.Cells(1, lCol1), ws1.Cells(1, lCol3)).EntireColumn.Delete
   
    With ws2
        .Range("A1").Resize(, 4) = Array("Part", "Make", "Model", "Year")
        .Range("A:D").Columns.AutoFit
        .Range("A1:D1").Font.Bold = True
    End With
   
    With ws2.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A1"), Order:=xlAscending
        .SortFields.Add Key:=Range("B1"), Order:=xlAscending
        .SortFields.Add Key:=Range("C1"), Order:=xlAscending
        .SortFields.Add Key:=Range("D1"), Order:=xlAscending
        .SetRange Range("A2:D" & lRow + 1)
        .Apply
    End With
End Sub
Hi mate,

It almost worked...

As an example, you can see the YZF-R6 model that there is way way more SKU's that what your code produced. Also my data had over 3000 rows and your code produced only about 3000+ rows where it would have needed to be a substantial amount more considering the amount of skus per model. What do you think??
 

Attachments

  • Screen Shot 2022-09-05 at 8.34.43 am.png
    Screen Shot 2022-09-05 at 8.34.43 am.png
    240.1 KB · Views: 6
  • Screen Shot 2022-09-05 at 8.32.59 am.png
    Screen Shot 2022-09-05 at 8.32.59 am.png
    230.4 KB · Views: 7
Upvote 0
Check again:
1) Category in column A:
MAKE/MODEL/YEAR (seperated by slashes / )
Is there any category in column A with more than 2 slashes (/)?

2) in debug window, when yellow highlight appears, we can track what variables "i" and "t" current value, by:
Move the mouse pointer to "i" and "t" letter (hover or just click) to see its current value.
What value does "'i" and "t" appear?
Hi Bebo,

Please see below what do you think? What should I do?
 

Attachments

  • Screen Shot 2022-09-05 at 8.47.25 am.png
    Screen Shot 2022-09-05 at 8.47.25 am.png
    53.4 KB · Views: 5
  • Screen Shot 2022-09-05 at 8.47.55 am.png
    Screen Shot 2022-09-05 at 8.47.55 am.png
    48.2 KB · Views: 5
  • Screen Shot 2022-09-05 at 8.47.45 am.png
    Screen Shot 2022-09-05 at 8.47.45 am.png
    38 KB · Views: 6
  • Screen Shot 2022-09-05 at 8.47.35 am.png
    Screen Shot 2022-09-05 at 8.47.35 am.png
    36.3 KB · Views: 6
Upvote 0
It seems work for me. Could you attach actual file via free site, i.e, toolbox or google drive?
 
Upvote 0
Try this new version

VBA Code:
Option Explicit
Sub shortjake_2()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    
    Dim rng As Range, rng1 As Range, rng2 As Range
    Set rng1 = ws1.Range("A3", ws1.Cells(Rows.Count, "A").End(xlUp))
    Set rng2 = ws1.Range("B3", ws1.Cells(Rows.Count, "B").End(xlUp))
    
    Dim lRow As Long, lCol1 As Long, lCol2 As Long, lCol3 As Long
    lCol1 = ws1.Cells.Find("*", , xlFormulas, , 2, 2).Column + 2
    lCol2 = lCol1 + 3
    
    Set rng = ws1.Range("A1").CurrentRegion
    rng.Value = Application.Trim(rng)
    
    Application.DisplayAlerts = False
    rng1.TextToColumns ws1.Cells(1, lCol1), 1, 1, , , , , , 1, "/"
    rng2.TextToColumns ws1.Cells(1, lCol2), 1, 1, , , , , , , ","
    Application.DisplayAlerts = True
    
    lRow = ws1.Cells(Rows.Count, lCol1).End(xlUp).Row
    lCol3 = ws1.Cells.Find("*", , xlFormulas, , 2, 2).Column
    
    Dim model, sku, arrOut
    model = ws1.Range(ws1.Cells(1, lCol1), ws1.Cells(lRow, lCol1 + 2))
    sku = ws1.Range(ws1.Cells(1, lCol2), ws1.Cells(lRow, lCol3))
    
    Dim x As Long
    x = WorksheetFunction.CountA(ws1.Range(ws1.Cells(1, lCol2), ws1.Cells(lRow, lCol3)))
    
    ReDim arrOut(1 To x, 1 To 4)
    Dim i As Long, j As Long, k As Long
    k = 1
    For i = 1 To UBound(sku, 1)
        For j = 1 To UBound(sku, 2)
            If IsEmpty(sku(i, 1)) Then Exit For
            If Not IsEmpty(sku(i, j)) Then
                arrOut(k, 1) = sku(i, j)
                arrOut(k, 2) = model(i, 1)
                arrOut(k, 3) = model(i, 2)
                arrOut(k, 4) = model(i, 3)
                k = k + 1
            End If
        Next j
    Next i
    
    ws2.Cells(2, 1).Resize(x, 4).Value = arrOut
    ws1.Range(ws1.Cells(1, lCol1), ws1.Cells(1, lCol3)).EntireColumn.Delete
    
    With ws2
        .Range("A1").Resize(, 4) = Array("Part", "Make", "Model", "Year")
        .Range("A:D").Columns.AutoFit
        .Range("A1:D1").Font.Bold = True
    End With
    
    With ws2.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A1"), Order:=xlAscending
        .SortFields.Add Key:=Range("B1"), Order:=xlAscending
        .SortFields.Add Key:=Range("C1"), Order:=xlAscending
        .SortFields.Add Key:=Range("D1"), Order:=xlAscending
        .SetRange Range("A2:D" & lRow + 1)
        .Apply
    End With
End Sub
 
Upvote 0
Solution
Try this new version

VBA Code:
Option Explicit
Sub shortjake_2()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
   
    Dim rng As Range, rng1 As Range, rng2 As Range
    Set rng1 = ws1.Range("A3", ws1.Cells(Rows.Count, "A").End(xlUp))
    Set rng2 = ws1.Range("B3", ws1.Cells(Rows.Count, "B").End(xlUp))
   
    Dim lRow As Long, lCol1 As Long, lCol2 As Long, lCol3 As Long
    lCol1 = ws1.Cells.Find("*", , xlFormulas, , 2, 2).Column + 2
    lCol2 = lCol1 + 3
   
    Set rng = ws1.Range("A1").CurrentRegion
    rng.Value = Application.Trim(rng)
   
    Application.DisplayAlerts = False
    rng1.TextToColumns ws1.Cells(1, lCol1), 1, 1, , , , , , 1, "/"
    rng2.TextToColumns ws1.Cells(1, lCol2), 1, 1, , , , , , , ","
    Application.DisplayAlerts = True
   
    lRow = ws1.Cells(Rows.Count, lCol1).End(xlUp).Row
    lCol3 = ws1.Cells.Find("*", , xlFormulas, , 2, 2).Column
   
    Dim model, sku, arrOut
    model = ws1.Range(ws1.Cells(1, lCol1), ws1.Cells(lRow, lCol1 + 2))
    sku = ws1.Range(ws1.Cells(1, lCol2), ws1.Cells(lRow, lCol3))
   
    Dim x As Long
    x = WorksheetFunction.CountA(ws1.Range(ws1.Cells(1, lCol2), ws1.Cells(lRow, lCol3)))
   
    ReDim arrOut(1 To x, 1 To 4)
    Dim i As Long, j As Long, k As Long
    k = 1
    For i = 1 To UBound(sku, 1)
        For j = 1 To UBound(sku, 2)
            If IsEmpty(sku(i, 1)) Then Exit For
            If Not IsEmpty(sku(i, j)) Then
                arrOut(k, 1) = sku(i, j)
                arrOut(k, 2) = model(i, 1)
                arrOut(k, 3) = model(i, 2)
                arrOut(k, 4) = model(i, 3)
                k = k + 1
            End If
        Next j
    Next i
   
    ws2.Cells(2, 1).Resize(x, 4).Value = arrOut
    ws1.Range(ws1.Cells(1, lCol1), ws1.Cells(1, lCol3)).EntireColumn.Delete
   
    With ws2
        .Range("A1").Resize(, 4) = Array("Part", "Make", "Model", "Year")
        .Range("A:D").Columns.AutoFit
        .Range("A1:D1").Font.Bold = True
    End With
   
    With ws2.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A1"), Order:=xlAscending
        .SortFields.Add Key:=Range("B1"), Order:=xlAscending
        .SortFields.Add Key:=Range("C1"), Order:=xlAscending
        .SortFields.Add Key:=Range("D1"), Order:=xlAscending
        .SetRange Range("A2:D" & lRow + 1)
        .Apply
    End With
End Sub
Thank you Kevin!

Cheers
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

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
Back
Top