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
 

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
With Data in Sheet1, results in Sheet2
VBA Code:
Option Explicit
Sub add()
Dim i&, j&, k&, t&, rng, cat, sku, arr(1 To 1000000, 1 To 4)
Sheets("Sheet1").Activate
rng = Range("A3:B" & Cells(Rows.Count, "A").End(xlUp).Row).Value
For i = 1 To UBound(rng)
    cat = Split(rng(i, 1), "/")
    sku = Split(rng(i, 2), ",")
    For j = 0 To UBound(sku)
        k = k + 1
        arr(k, 1) = sku(j)
        For t = 0 To UBound(cat)
            arr(k, t + 2) = cat(t)
        Next
    Next
Next
Sheets("Sheet2").Activate
Range("A1:D1").Value = Array("Part", "Make ", "Model", "Year")
Range("A2:D1000000").ClearContents
Range("A2").Resize(k, 4).Value = arr
With ActiveSheet.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").Resize(k, 4)
        .Apply
End With
End Sub
 
Upvote 0
With Data in Sheet1, results in Sheet2
VBA Code:
Option Explicit
Sub add()
Dim i&, j&, k&, t&, rng, cat, sku, arr(1 To 1000000, 1 To 4)
Sheets("Sheet1").Activate
rng = Range("A3:B" & Cells(Rows.Count, "A").End(xlUp).Row).Value
For i = 1 To UBound(rng)
    cat = Split(rng(i, 1), "/")
    sku = Split(rng(i, 2), ",")
    For j = 0 To UBound(sku)
        k = k + 1
        arr(k, 1) = sku(j)
        For t = 0 To UBound(cat)
            arr(k, t + 2) = cat(t)
        Next
    Next
Next
Sheets("Sheet2").Activate
Range("A1:D1").Value = Array("Part", "Make ", "Model", "Year")
Range("A2:D1000000").ClearContents
Range("A2").Resize(k, 4).Value = arr
With ActiveSheet.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").Resize(k, 4)
        .Apply
End With
End Sub
Hi Bebo,

Thank you for your message!! Do you have any instructions on how to use that above? And do I need to modify it to include all of the data on my worksheet (i couldnt share all of it due to constraints of the minisheet.... Thank you very much mate
 
Upvote 0
Its VBA solution. If you are new VBA user, try following steps:
- Alt-F11 to open VBA window
- Insert/Module
- copy code and paste into
- Hit F5 or play button to run
Or you can insert a shape, then right click on it, assign code. Then click on shape to run.
Good luck.
 
Upvote 0
Hi mate, Im receiving this error.....
 

Attachments

  • Screen Shot 2022-09-01 at 12.24.36 pm.png
    Screen Shot 2022-09-01 at 12.24.36 pm.png
    152.7 KB · Views: 23
  • Screen Shot 2022-09-01 at 12.24.42 pm.png
    Screen Shot 2022-09-01 at 12.24.42 pm.png
    133.9 KB · Views: 24
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?
 
Upvote 0
I think @bebo021999 has the better solution - I did this purely as an exercise in text-to-columns. It works for me so might as well share. It assumes your data is on "Sheet1" and that your configured data goes to "Sheet2".

VBA Code:
Option Explicit
Sub shortjake()
    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, , , , , , , "/"
    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
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 mate,

1) No all columns as far as I can see have two slashes.

2) Do you mean k & t ?? i=1917 k=12453 and t=3 cat(t)= "2015"

Could is be that my range goes to row 3487 currently and if you consider the amount of skus there could be over 1000000 rows after the manipulation?

Thank you
 
Upvote 0
D
I think @bebo021999 has the better solution - I did this purely as an exercise in text-to-columns. It works for me so might as well share. It assumes your data is on "Sheet1" and that your configured data goes to "Sheet2".

VBA Code:
Option Explicit
Sub shortjake()
    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, , , , , , , "/"
    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, 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
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

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