Excel VBA to Copy and Paste by Looking Up Values

[browncountry]

[TABLE="class: grid, width: 300"]
<tbody>[TR]
[TD][/TD]
[TD]A
[/TD]
[TD]B
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]Item Number (Kit)

[/TD]
[TD]Qty
[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]Kit 456
[/TD]
[TD]3
[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD]Kit 123
[/TD]
[TD]1
[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]Kit 789
[/TD]
[TD]2
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]

SHEET 1
​

[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: center"]A
[/TD]
[TD="align: center"]B
[/TD]
[/TR]
[TR]
[TD]1
[/TD]
[TD]Item Number (Kit)

[/TD]
[TD]Parts within kit

[/TD]
[/TR]
[TR]
[TD]2
[/TD]
[TD]Kit 123
[/TD]
[TD]Part 1

[/TD]
[/TR]
[TR]
[TD]3
[/TD]
[TD][/TD]
[TD]Part 2

[/TD]
[/TR]
[TR]
[TD]4
[/TD]
[TD]Kit 456
[/TD]
[TD]Part 1
[/TD]
[/TR]
[TR]
[TD]5
[/TD]
[TD][/TD]
[TD]Part 2
[/TD]
[/TR]
[TR]
[TD]6
[/TD]
[TD]Kit 789
[/TD]
[TD]Part 1
[/TD]
[/TR]
[TR]
[TD]7
[/TD]
[TD][/TD]
[TD]Part 2
[/TD]
[/TR]
[TR]
[TD]8
[/TD]
[TD][/TD]
[TD]Part 3
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD="align: center"]SHEET 2
[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I have a sheet labeled "Sheet 1" with a list of part numbers (which are kits with multiple parts that go into them) and their quantities as shown above.

Sheet 2 is a master list of kits and the parts that belong to them. My objective is to search Sheet 2 for kits showing in Sheet 1 and copy and paste them in Sheet 3 the amount of times listed in Sheet 1 until I get to the last row of Sheet 1 with VBA code. Does that make sense?

Sheet 1 is an input sheet and Sheet 3 is an output sheet. If anyone has any suggestions on how to go about doing this, it would be very much appreciated! Thanks in advance.

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG03Feb12
[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] Temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
    Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Offset(, -1)
    Temp = IIf(Dn.Value = "", Temp, Dn.Value)
        [COLOR="Navy"]If[/COLOR] Not Dic.exists(Temp) [COLOR="Navy"]Then[/COLOR]
            Dic.Add Temp, Dn
        [COLOR="Navy"]Else[/COLOR]
            [COLOR="Navy"]Set[/COLOR] Dic(Temp) = Union(Dic(Temp), Dn)
        [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
c = 2
[COLOR="Navy"]With[/COLOR] Sheets("Sheet3")
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
   [COLOR="Navy"]If[/COLOR] Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
     [COLOR="Navy"]For[/COLOR] n = 1 To Dn.Offset(, 1).Value
         Dic(Dn.Value).Resize(Dic(Dn.Value).Count, 2).Copy .Cells(c, 1)
         c = c + Dic(Dn.Value).Count
     [COLOR="Navy"]Next[/COLOR] n
   [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[browncountry]

This is EXACTLY what I needed! It works like a charm. Thanks a bunch Mick!

 

[MickG]

You're welcome