Insert Rows After Match

[mrroland]

Hi,

I have a list of Bill of materials but some of them only include the upper level. I now have a separate sheet which includes the secondary levels. My aim is to match the upper levels and then insert the rows underneath.
Not all items in Sheet 2 do match the items in Sheet 1. The numbers of rows of the secondary levels can vary.
I hope the attached example makes the above more clear.

Book1
	B	C	D	E	F	G	H
2	Sheet 1				Desired Result
3	Tag	Upper Level	Qty		Tag	B.O.M.	Qty
4	Item 1	856382-001	1		Item 1	856382-001	1
5	Item 2	828195-001	1		Item 1	Part 1	1
6					Item 1	Part 2	1
7	Sheet 2				Item 1	Part 3	6
8	Upper Level	Secondary Level	Qty		Item 1	Part 4	1
9	856382-001	Part 1	1		Item 1	Part 5	2
10	856382-001	Part 2	1		Item 2	828195-001
11	856382-001	Part 3	6		Item 2	Part 12	1
12	856382-001	Part 4	1		Item 2	Part 13	3
13	856382-001	Part 5	2		Item 2	Part 14	1
14	828195-001	Part 12	1		Item 2	Part 15	3
15	828195-001	Part 13	3		Item 2	Part 16	1
16	828195-001	Part 14	1		Item 2	Part 17	1
17	828195-001	Part 15	3
18	828195-001	Part 16	1
19	828195-001	Part 17	1
Sheet1

Your help is greatly appreciated as this is a very long list and to do it manualy will take the better part of my remaining working week.

Cheers,
Roland

 

[Harvey]

this code will sum up all data the way you stated from Blad1 and Blad2 and add it to Blad3. (This means when you run it twice, the data is entered twice too!) Past it into a module and run it.

Sub SumTotals()

    Dim Upperlevel As Range
    Dim Secondarylevel As Range
    Dim TmpRange As Range
    Dim rij As Integer
    
    For Each Upperlevel In Range("Blad1!A2:A10")
        Range(Upperlevel, Upperlevel.Offset(0, 2)).Copy
        rij = Application.WorksheetFunction.CountA(Range("Blad3!A:A")) + 1
        Set TmpRange = Range("Blad3!A" & rij)
        Range(TmpRange, TmpRange.Offset(0, 2)).PasteSpecial
        For Each Secondarylevel In Range("Blad2!A2:A10")
            If Secondarylevel.Value = Upperlevel.Offset(0, 1).Value Then
                Range(Secondarylevel.Offset(0, 1), Secondarylevel.Offset(0, 2)).Copy
                rij = Application.WorksheetFunction.CountA(Range("Blad3!A:A")) + 1
                Set TmpRange = Range("Blad3!A" & rij)
                Range(TmpRange.Offset(0, 1), TmpRange.Offset(0, 2)).PasteSpecial
                Upperlevel.Copy
                TmpRange.PasteSpecial
            End If
        Next Secondarylevel
    Next Upperlevel

End Sub

 

[mrroland]

Harvey,

Thanks for the reply and your help. I tried your code and although it runs without problems the outcome is not matching my desired result. Never mind. I got the IT department to deliver me a different layout which made my life a bit easyer and have concurred the problem now within half an hour with some labour and formulas. Though I think VBA is the best solution for this. Bought a book about it and am now learning.

Thanks again for your help.

Cheers,
Roland