creating an extended list of data

[LizGough]

I'm hoping someone can help me - I've been pondering over a solution for a few days now!
I have a large list of part numbers, with their material parts that make that part. I have extracted the 2 columns of data from a Microsoft Query. Below is a small example - part num 1D001A is made up of 8 material parts. Although not seen in the list below, some of the MtlPartNum are also listed within the PartNum column, as they also require MtlPartNums to make them (basically a sub part) - I know that Material Part 3D284H has a sub part.

PartNum MtlPartNum
1D001A 3D284H
1D001A 3D285A
1D001A 3D288A
1D001A 3F8CT120S4
1D001A 3F8FN000S4
1D001A 3F8WP000S2
1D001A 3H582H
1D001A 3R473A
1D002A 3D284H
1D002A 3D285A
1D002A 3D288A
1D002A 3F019A
1D002A 3F8FN000S4
1D002A 3F8WP000S2
1D002A 3H582H
1D002A 3R473A
1D003A 3D312H
1D003A 3F8CT120S4
1D003A 3F8FN000S4
1D003A 3F8WB000S2
1D003A 3H602H
1D003A 3R473A
1D004A 3D337A
1D004A 3D339H
1D004A 3D340A
1D004A 3F10CT120S4
1D004A 3F10FN000S4
1D004A 3F10WP000S2
1D004A 3H583H
1D004A 3R473A
1D005A 3D337A

I haven't been able to find the data I want from the tables linked in the Microsoft query database, so am having to do a manual work around. What I am trying to achieve is a full bill of materials for a given part. I would like the data to end up looking like this:
Where a MtlPartNum has a sub part, such as 1W020A below, I would still like to have a separate row for the mtl part, as well as separate rows for all the sub parts.

PartNum MtlPart MtlPart2 MtlPart3
DW-LJH5D/A1 1W005A
DW-LJH5D/A1 1W020A
DW-LJH5D/A1 1W020A 2W124A
DW-LJH5D/A1 1W020A 3W409A
DW-LJH5D/A1 2W144A
DW-LJH5D/A1 2W144A 3W087E
DW-LJH5D/A1 2W144A 3W088E
DW-LJH5D/A1 2W144A 3W034A
DW-LJH5D/A1 2W144A 3W125A
DW-LJH5D/A1 2W144A 3W136A
DW-LJH5D/A1 2W144A 3W023A
DW-LJH5D/A1 2W144A 3W024A
DW-LJH5D/A1 2W144A 3W163A
DW-LJH5D/A1 2W144A 3W175A
DW-LJH5D/A1 2W144A 3W138A
DW-LJH5D/A1 2W243A
DW-LJH5D/A1 2W243A 3W247A
DW-LJH5D/A1 2W243A 3W385A
DW-LJH5D/A1 3R481A
DW-LJH5D/A1 3R500A
DW-LJH5D/A1 3R518A
DW-LJH5D/A1 3R545A
DW-LJH5D/A1 3R694A
DW-LJH5D/A1 3R724A
DW-LJH5D/A1 3R847A
DW-LJH5D/A1 3W115A
DW-LJH5D/A1 3W143A
DW-LJH5D/A1 3W229A
DW-LJH5D/A1 3W234A
DW-LJH5D/A1 3W311A
DW-LJH5D/A1 3W312A
DW-LJH5D/A1 3R881A

I would like this layout, as I have a lot of other data to tag into the other columns.
So far I have only been able to create the following layout: The sub part data was created using the following array formula: {=IFERROR(INDEX($B:$B, SMALL(IF([@MtlPartNum]=$A:$A, ROW($A:$A)-ROW($A$1)+1), COLUMN(A2173))),"")}
PartNum MtlPartNum Sub Part1 Sub Part2 Sub Part3 Sub Part4 Sub Part5 Sub Part6 Sub Part7 Sub Part8 Sub Part9 Sub Part10 Sub Part11 Sub Part12
DW-LJH5D/A1 1W005A 0
DW-LJH5D/A1 1W020A Has Sub Part 2W124A 3W409A
DW-LJH5D/A1 2W144A Has Sub Part 3W023A 3W024A 3W034A 3W087E 3W088E 3W125A 3W136A 3W138A 3W163A 3W175A
DW-LJH5D/A1 2W243A Has Sub Part 3W247A 3W385A
DW-LJH5D/A1 3R481A 0
DW-LJH5D/A1 3R500A 0
DW-LJH5D/A1 3R518A 0
DW-LJH5D/A1 3R545A 0
DW-LJH5D/A1 3R694A 0
DW-LJH5D/A1 3R724A 0
DW-LJH5D/A1 3R847A 0
DW-LJH5D/A1 3R881A 0
DW-LJH5D/A1 3W115A 0
DW-LJH5D/A1 3W143A 0
DW-LJH5D/A1 3W229A 0
DW-LJH5D/A1 3W234A 0
DW-LJH5D/A1 3W311A 0
DW-LJH5D/A1 3W312A 0

I have over 15000 rows of data and the above formula takes a lot of processing memory to update, and the layout is not practical for what I want to achieve.

So what I'm asking, is there a way, even using VBA, to create the layout I want?
Any help would be greatly received.

Thanks,

 

[MickG]

Have you a before and after example for data that matches, so that it can be used to work on ?????

 

[LizGough]

As in the actual spreadsheets? Sorry, very new to this!

 

[MickG]

Yes Just an example really, that shows the sort of data you have initially , and an example of what you would expect after the code has run.
Your data at the moment only seems to show what you would expect the results to be, but not what the original data would look like.
It does not have to be the full set of data just enough to be able to work out how the "before" data would be transformed into the "After" data.

 

[LizGough]

Sorry - I have no idea how to attach to this post.

The data in my original email is exactly how it would be displayed in a spreadsheet.
The below is in 2 columns in excel. This data is brought into Excel via Query. Some of the Materials in column B are also listed as a Part in Column A (eg 2W144A).

PartNum MtlPartNum
1W020A 2W124A
1W020A 3W409A
2W144A 3W125A
2W144A 3W023A
2W144A 3W024A
2W144A 3W034A
2W144A 3W087E
2W144A 3W088E
2W144A 3W136A
2W144A 3W138A
2W144A 3W163A
2W144A 3W175A
2W243A 3W385A
2W243A 3W247A
DW-LJH5D/A1 3R518A
DW-LJH5D/A1 3R545A
DW-LJH5D/A1 3R694A
DW-LJH5D/A1 3R724A
DW-LJH5D/A1 1W020A
DW-LJH5D/A1 2W144A
DW-LJH5D/A1 3R847A
DW-LJH5D/A1 3W115A
DW-LJH5D/A1 3W143A
DW-LJH5D/A1 3W229A
DW-LJH5D/A1 3W234A
DW-LJH5D/A1 3W311A
DW-LJH5D/A1 2W243A
DW-LJH5D/A1 3R481A
DW-LJH5D/A1 3R500A
DW-LJH5D/A1 3R881A
DW-LJH5D/A1 1W005A
DW-LJH5D/A1 3W312A


What I would like to achieve is this layout of the data in excel:
PartNum MtlPart MtlPart2
DW-LJH5D/A1 1W005A
DW-LJH5D/A1 1W020A
DW-LJH5D/A1 1W020A 2W124A
DW-LJH5D/A1 1W020A 3W409A
DW-LJH5D/A1 2W144A
DW-LJH5D/A1 2W144A 3W087E
DW-LJH5D/A1 2W144A 3W088E
DW-LJH5D/A1 2W144A 3W034A
DW-LJH5D/A1 2W144A 3W125A
DW-LJH5D/A1 2W144A 3W136A
DW-LJH5D/A1 2W144A 3W023A
DW-LJH5D/A1 2W144A 3W024A
DW-LJH5D/A1 2W144A 3W163A
DW-LJH5D/A1 2W144A 3W175A
DW-LJH5D/A1 2W144A 3W138A
DW-LJH5D/A1 2W243A
DW-LJH5D/A1 2W243A 3W247A
DW-LJH5D/A1 2W243A 3W385A
DW-LJH5D/A1 3R481A
DW-LJH5D/A1 3R500A
DW-LJH5D/A1 3R518A
DW-LJH5D/A1 3R545A
DW-LJH5D/A1 3R694A
DW-LJH5D/A1 3R724A
DW-LJH5D/A1 3R847A
DW-LJH5D/A1 3W115A
DW-LJH5D/A1 3W143A
DW-LJH5D/A1 3W229A
DW-LJH5D/A1 3W234A
DW-LJH5D/A1 3W311A
DW-LJH5D/A1 3W312A
DW-LJH5D/A1 3R881A

Part DW-LJH5D/A1 (column A) is made up of many material parts (column B). Some of the material parts have also got their own material parts (column C).
In total, for part DW-LJH5D/A1, there are 32 rows of data needed for me to do my further analysis. Each Material part has its own row of data, and also each sub material part has its own data.

I'm quite happy for the results to appear in another worksheet. Some of the material parts (B) will be used in several parts (A).

I hope this explains a bit better?

Thanks,

 

[MickG]

Try this on your forum Data first, Results start sheet2 "A1".

[COLOR=Navy]Sub[/COLOR] MG28Oct33
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] K [COLOR=Navy]As[/COLOR] Variant, Temp [COLOR=Navy]As[/COLOR] Range
[COLOR=Navy]Dim[/COLOR] Dic1 [COLOR=Navy]As[/COLOR] Object, Dic2 [COLOR=Navy]As[/COLOR] Object, Str [COLOR=Navy]As[/COLOR] [COLOR=Navy]String[/COLOR]
[COLOR=Navy]Dim[/COLOR] c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Ac [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Sp [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
    [COLOR=Navy]Set[/COLOR] Dic1 = CreateObject("scripting.dictionary")
        Dic1.CompareMode = vbTextCompare
    [COLOR=Navy]Set[/COLOR] Dic2 = CreateObject("scripting.dictionary")
        Dic2.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng: [COLOR=Navy]Set[/COLOR] Dic1(Dn.Value) = Dn.Offset(, 1): [COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng.Offset(, 1): [COLOR=Navy]Set[/COLOR] Dic2(Dn.Value) = Dn.Offset(, -1): [COLOR=Navy]Next[/COLOR] Dn
ReDim ray(1 To Rng.Count, 1 To 1)
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng.Offset(, 1)
  [COLOR=Navy]If[/COLOR] Not Dic1.exists(Dn.Value) [COLOR=Navy]Then[/COLOR]
    c = c + 1: Ac = 0: Str = ""
    [COLOR=Navy]Set[/COLOR] Temp = Dic2(Dn.Value)
    Str = Dn.Value & "," & Temp
        [COLOR=Navy]Do[/COLOR] [COLOR=Navy]While[/COLOR] Dic2.exists(Temp.Value)
            [COLOR=Navy]Set[/COLOR] Temp = Dic2(Temp.Value)
            [COLOR=Navy]If[/COLOR] Temp = "" [COLOR=Navy]Then[/COLOR] Stop
            Str = Str & "," & Temp
        [COLOR=Navy]Loop[/COLOR]
Sp = Split(Str, ",")
[COLOR=Navy]For[/COLOR] n = UBound(Sp) To 0 [COLOR=Navy]Step[/COLOR] -1
    Ac = Ac + 1
    [COLOR=Navy]If[/COLOR] Ac > UBound(ray, 2) [COLOR=Navy]Then[/COLOR] ReDim Preserve ray(1 To Rng.Count, 1 To Ac)
    [COLOR=Navy]If[/COLOR] Sp(n) = "," [COLOR=Navy]Then[/COLOR] Stop
    ray(c, Ac) = Sp(n)
[COLOR=Navy]Next[/COLOR] n
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]Dim[/COLOR] Rw [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
Dic1.RemoveAll: Ac = 0
[COLOR=Navy]Dim[/COLOR] Col [COLOR=Navy]As[/COLOR] [COLOR=Navy]Integer,[/COLOR] Dta [COLOR=Navy]As[/COLOR] [COLOR=Navy]String,[/COLOR] P [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]
[COLOR=Navy]For[/COLOR] Ac = 2 To UBound(ray, 2)
    [COLOR=Navy]For[/COLOR] Rw = 1 To c
        Dta = ""
        [COLOR=Navy]For[/COLOR] Col = 1 To Ac
            [COLOR=Navy]If[/COLOR] Not IsEmpty(ray(Rw, Ac)) [COLOR=Navy]Then[/COLOR]
            Dta = Dta & "," & Trim(ray(Rw, Col))
            [COLOR=Navy]End[/COLOR] If
        [COLOR=Navy]Next[/COLOR] Col
            Dta = Mid(Dta, 2)
    [COLOR=Navy]If[/COLOR] Not Dta = "" [COLOR=Navy]Then[/COLOR]
    [COLOR=Navy]If[/COLOR] Not Dic1.exists(Trim(Dta)) [COLOR=Navy]Then[/COLOR]
        Dic1.Add Trim(Dta), Nothing
        Sp = Split(Dta, ",")
        P = P + 1
        Sheets("Sheet2").Cells(P, "A").Resize(, UBound(Sp) + 1) = Sp
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR] Rw
[COLOR=Navy]Next[/COLOR] Ac
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]

Regards Mick

 

[LizGough]

Thank you.
This so nearly works
It hasn't pulled all the parts into the new sheet though.
All the parts in Column A should be listed in the new sheet, with all their material parts.
Sorry. hope you can help further