Excel VBA to Copy and Paste by Looking Up Values

[browncountry]

	A	B
1	Item Number (Kit)	Qty
2	Kit 456	3
3	Kit 123	1
4	Kit 789	2
	SHEET 1 ​
	A	B
1	Item Number (Kit)	Parts within kit
2	Kit 123	Part 1
3		Part 2
4	Kit 456	Part 1
5		Part 2
6	Kit 789	Part 1
7		Part 2
8		Part 3
	SHEET 2

<tbody>
</tbody>

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