VBA - Inserting n rows to allow for extended range

[UlyssesFR]

Hello Everyone

Given the following source range on Worksheets(SOURCE):

B738D ACCESS Lav Moc Overview- Input File_CEDRIC_TESTMACRO.xlsm
	A	B
1	Part Number	Function Code
2	PART NUMBER A	1.01
3	PART NUMBER B	1.01
4	PART NUMBER C	1.02
5	PART NUMBER D	1.02
6	PART NUMBER E	1.02
7	PART NUMBER F	1.02
8	PART NUMBER G	1.02
9	PART NUMBER H	1.02
10	PART NUMBER I	1.02
11	PART NUMBER J	1.02
12	PART NUMBER K	1.04
13	PART NUMBER L	1.04
14	PART NUMBER M	1.04
15	PART NUMBER N	1.04
16	PART NUMBER O	1.05
17	PART NUMBER P	1.05
18	PART NUMBER Q	1.05
19	PART NUMBER R	1.05
20	PART NUMBER S	1.05
21	PART NUMBER T	1.05
22	PART NUMBER U	1.05
SOURCE

And the following recipient table on Worksheets(RECIPIENT):

B738D ACCESS Lav Moc Overview- Input File_CEDRIC_TESTMACRO.xlsm
	A	B	C
1	Function Code	Part Number	Tests
2	1.01		Test1
3			Test2
4			Test3
5			Test4
6			Test5
7			Test6
8	1.02		Test1
9			Test2
10			Test3
11			Test4
12			Test5
13			Test6
14	1.03		Test1
15			Test2
16			Test3
17			Test4
18			Test5
19			Test6
20	1.04		Test1
21			Test2
22			Test3
23			Test4
24			Test5
25			Test6
26	1.05		Test1
27			Test2
28			Test3
29			Test4
30			Test5
31			Test6
RECIPIENT

I would like to achieve this:

B738D ACCESS Lav Moc Overview- Input File_CEDRIC_TESTMACRO.xlsm
	A	B	C	D
1	Function Code	Part Number	Tests
2	1.01	PART NUMBER A	Test1	'VBA code looks at the Function Code in worksheets(RECIPIENT).Columns(A) then returns the matching range of Part Numbers from worksheets(SOURCE).Columns(A) in worksheets(RECIPIENT).Columns(B). 'If the matching range of Part Numbers for a particular Function Code is larger than 6 rows, then n rows need to be inserted to adjust for the difference: i.e. Function Code 1.02 has 8 matching Part Numbers - PART NUMBER C to PART NUMBER J - therefore we need to insert n = 8 - 6 = 2 extra rows before the next Function Code 1.03 to allow for PART NUMBER I and J. 'If the matching range Part Numbers for a particular Function Code is smaller than or equal to 6, then no need to insert new rows and the matching Part Numbers can just be copied in. 'If no matching Part Numbers are found for a particular Function Code, go to next Function Code. 'Worksheets(RECIPIENT).Columns(C) range Test1 to Test6 need to stay "anchored" at the top when inserted new rows.
3		PART NUMBER B	Test2
4			Test3
5			Test4
6			Test5
7			Test6
8	1.02	PART NUMBER C	Test1
9		PART NUMBER D	Test2
10		PART NUMBER E	Test3
11		PART NUMBER F	Test4
12		PART NUMBER G	Test5
13		PART NUMBER H	Test6
14		PART NUMBER I
15		PART NUMBER J
16	1.03		Test1
17			Test2
18			Test3
19			Test4
20			Test5
21			Test6
22	1.04	PART NUMBER K	Test1
23		PART NUMBER L	Test2
24		PART NUMBER M	Test3
25		PART NUMBER N	Test4
26			Test5
27			Test6
28	1.05	PART NUMBER O	Test1
29		PART NUMBER P	Test2
30		PART NUMBER Q	Test3
31		PART NUMBER R	Test4
32		PART NUMBER S	Test5
33		PART NUMBER T	Test6
34		PART NUMBER U
RESULT

Where can I start? I wish my boss would give me enough time to suss this one out by myself, but unfortunately, he doesn't

Any help or pointers would be greatly appreciated!

Kind regards.

 

[DanteAmor]

Probably there is a better macro and maybe faster.
But check if the following works for you.

Also comment on how many records you have on both sheets.
In the sheet "RECIPIENT" for each FucntionCode there are always 6 records?

Try this:

Sub Inserting_n_rows()
  Dim sh1 As Worksheet, sh2 As Worksheet, fCode As Variant
  Dim i As Long, j As Long, nCount As Long, nhas As Long, ini As Long
  
  Application.ScreenUpdating = False
  Set sh1 = Sheets("SOURCE")
  Set sh2 = Sheets("RECIPIENT")
  For i = sh2.Range("C" & Rows.Count).End(3).Row To 2 Step -1
    nhas = i - sh2.Range("A" & i).End(3).Row + 1
    j = sh2.Range("A" & i).End(3).Row
    fCode = sh2.Range("A" & j)
    nCount = WorksheetFunction.CountIf(sh1.Range("B:B"), fCode)
    If nCount > 0 Then
      If nhas < nCount Then
        sh2.Range("A" & i + 1 & ":A" & i + (nCount - nhas)).EntireRow.Insert
      End If
      ini = sh1.Range("B:B").Find(fCode, , xlValues, xlWhole, xlByRows, xlNext, False).Row
      sh2.Range("B" & j).Resize(nCount).Value = sh1.Range("A" & ini).Resize(nCount).Value
    End If
    i = i - nhas + 1
  Next
End Sub

 

[UlyssesFR]

Wow, amazing!

I did start going the CountIf route but it was nowhere as streamlined / elegant as this.

I went as far as inserting the needed amount of rows but then hit a brick wall when trying to copy the matching data.

I haded a bit of code to loop through all my source sheets and it works a treat.

Thank you vvvvvery much!

Sub Distribute_Part_Numbers()

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim fCode As Variant
Dim i As Long
Dim j As Long
Dim nCount As Long
Dim nhas As Long
Dim ini As Long
Dim WB_TWB As Workbook
Dim WS As Worksheet
  
Application.ScreenUpdating = False
  
Set sh1 = Sheets("COMBINED")
Set WB_TWB = ThisWorkbook
  
    For Each WS In WB_TWB.Worksheets
        With WB_TWB.Worksheets(WS.Name)
            If WS.Name Like "FB*" Then
                .Activate
                For i = Sheets(WS.Name).Range("E" & Rows.count).End(3).Row To 2 Step -1
                    nhas = i - Sheets(WS.Name).Range("A" & i).End(3).Row + 1
                    j = Sheets(WS.Name).Range("A" & i).End(3).Row
                    fCode = Sheets(WS.Name).Range("A" & j)
                    nCount = WorksheetFunction.CountIf(sh1.Range("D:D"), fCode)
                        If nCount > 0 Then
                                If nhas < nCount Then
                                    Sheets(WS.Name).Range("A" & i + 1 & ":A" & i + (nCount - nhas)).EntireRow.Insert
                                End If
                            ini = sh1.Range("D:D").Find(fCode, , xlValues, xlWhole, xlByRows, xlNext, False).Row
                            Sheets(WS.Name).Range("C" & j).Resize(nCount).Value2 = sh1.Range("A" & ini).Resize(nCount).Value2
                        End If
                    i = i - nhas + 1
                Next
            End If
        End With
    Next WS
    
Application.ScreenUpdating = True
    
End Sub

 

[UlyssesFR]

I won't lie though, I'm having a hard time wrapping my head around how the code works, especially the

.Find()

part


I'll have a closer look at it when/if I have a bit of spare time at work, but in the meantime, I will blindly use it

 

[UlyssesFR]

I may have spoken too soon...

I've been trying now for a few hours to replicate the first time the code ran (and seemingly worked) but for some reason, it won't work again.

As I hinted above, I have 5 "Recipient" Sheets, named FB1, FB2... to FB5 (not several Source sheets as I mistakenly mentioned above)

All of them have the exact same format:

B738D ACCESS Lav MoC Overview (Assys Only)_20200727_1518.xlsm
	A	B	C	D	E
1	Function Code	Function Sub-Category	Assy P/N	Component P/N	Tests
2	1.01	Side Wall Panel	N254L4051-000		Structural Integrity
3			N254L4055-000		Flammability & Smoke
4					Handling & Abuse
5					Environmental Conditions
6					Endurance
7					Vibration
8					USPHS
9	1.02	Aisle Wall Panel	N254L4052-000		Structural Integrity
10			N254L4058-000		Flammability & Smoke
11					Handling & Abuse
12					Environmental Conditions
13					Endurance
14					Vibration
15					USPHS
16	1.03	Rear Wall Panel			Structural Integrity
17					Flammability & Smoke
18					Handling & Abuse
19					Environmental Conditions
20					Endurance
21					Vibration
22					USPHS
23	1.04	Ceiling Panel	N254L4034-000		Structural Integrity
24			N254L4054-000		Flammability & Smoke
25			N254L4059-000		Handling & Abuse
26			N254L4060-000		Environmental Conditions
27					Endurance
28					Vibration
29					USPHS
30	1.05	Floor Assy	N254L4053-000		Structural Integrity
31			N254L4057-000		Flammability & Smoke
32					Handling & Abuse
33					Environmental Conditions
34					Endurance
35					Vibration
36					USPHS
FB1

The function code in column A runs up to 1.99 for FB1, up to 2.99 for FB2... and up to 5.99 for FB3.

The source sheet is as follow

B738D ACCESS Lav MoC Overview (Assys Only)_20200727_1518.xlsm
	A	B	C	D	E
1	PART NUMBER	DESCRIPTION	MATERIAL	FUNCTION CODE	USED IN
2	N254L4051-000	PANEL, FWD ASSY	N/A	1.01	N254L4005-000
3	N254L4055-000	PANEL, AFT ASSY	N/A	1.01	N254L4003-000
4	N254L4052-000	PANEL, AISLE FWD ASSY	N/A	1.02	N254L4005-000
5	N254L4058-000	PANEL, AISLE AFT ASSY	N/A	1.02	N254L4003-000
6	N254L4034-000	CEILING PANEL ASSY	N/A	1.04	N254L4001-000
7	N254L4054-000	PANEL, TOP FWD ASSY	N/A	1.04	N254L4005-000
8	N254L4059-000	PANEL, TOP AFT ASSY	N/A	1.04	N254L4003-000
9	N254L4060-000	PANEL ASSY	N/A	1.04	N254L4003-000
10	N254L4053-000	PANEL, BASE FWD ASSY	N/A	1.05	N254L4005-000
11	N254L4057-000	PANEL, BASE AFT ASSY	N/A	1.05	N254L4003-000
12	N254L4030-000	PANEL ASSY	N/A	1.06	N254L4001-000
13	N254L4035-000	CLOSEOUT PANEL ASSY	N/A	1.06	N254L4001-000
14	N254L4064-000	PANEL ASSY	N/A	1.06	N254L4001-000
15	N254L4007-000	PRM LAVATORY BONDED ASSY, EXPANDING SECTION	N/A	1.07	N254L4006-000
16	N254L4010-000	SLIDING PANEL ASSY	N/A	1.07	N254L4001-000
17	N254L4027-000	BI-FOLD PANEL ASSY	N/A	1.07	N254L4001-000
18	N254L4032-000	BUMPER ASSY	N/A	1.07	N254L4002-000
19	N254L4032-002	BUMPER ASSY	N/A	1.07	N254L4002-000
20	N254L4033-000	BUMPER ASSY	N/A	1.07	N254L4004-000
21	N254L4061-000	PANEL, TOP, EXPANDING SECTION ASSY	N/A	1.07	N254L4007-000
22	N254L4062-000	SLIDING PANEL BONDED ASSY	N/A	1.07	N254L4010-000
23	N254L4063-000	PANEL ASSY, AFT, EXPANDING SECTION	N/A	1.07	N254L4007-000
24	N254L4026-000	TOILET SHROUD ASSY	N/A	1.08	N254L4001-000
25	N254L4046-000	ROLL ASSY	N/A	1.08	N254L4004-000
26	N254L4065-000	BRACKET ASSY, TOILET SHROUD	N/A	1.08	N254L4002-000
27	N254L4009-000	DOOR ASSY	N/A	1.09	N254L4006-000
28	N254L4043-000	DOOR BONDED ASSY	N/A	1.09	N254L4009-000
29	N254L4006-000	PRM LAVATORY GENERAL ASSY, EXPANDING SECTION	N/A	1.99	N254L4001-000
30	N240L4001-000	MICROSWITCH DISCONNECT ASSY	N/A	2.06	N240L1001-000
31	N254L4056-000	MICRO SWITCH ASSY	N/A	2.06	N254L4010-000
32	N240L4002-000	GROUND STUD BRACKET ASSY	N/A	2.07	N240L1001-000
33	N332L4001-000	MAIN LIGHT ASSY	N/A	2.99	N240L1001-000
34	N212L4001-000	HOSE COUPLER ASSY	N/A	3.01	N212L1001-000
35	N212L4002-000	PLENUM, VENTILATION ASSY	N/A	3.01	N212L1002-000
36	N381L4001-000	DISCONNECT WELDED ASSY	N/A	3.03	N381L1001-000
37	N383L4001-000	OVERFLOW PIPE ASSY	N/A	3.07	N383L1001-000
38	N380L4001-000	VACUUM WASTE ASSY	N/A	3.99	N380L1001-000
39	N254L4013-000	VANITY UNIT ASSY	N/A	4.01	N254L4004-000
40	N254L4015-000	DOOR ASSY, SINK	N/A	4.01	N254L4013-000
41	N254L4019-000	VANITY UNIT BONDED ASSY	N/A	4.01	N254L4013-000
42	N254L4047-000	BRACKET ASSY	N/A	4.01	N254L4004-000
43	N254L4048-000	ANGLE ASSY	N/A	4.01	N254L4013-000
44	N254L4049-000	ANGLE ASSY	N/A	4.01	N254L4013-000
45	N254L4017-000	DOOR ASSY, ROLL MIDDLE	N/A	4.02	N254L4004-000
46	N254L4018-000	DOOR ASSY, ROLL TOP	N/A	4.03	N254L4004-000
47	N254L4022-000	TABLE SUPPORT ASSY	N/A	4.05	N254L4002-000
48	N254L4036-000	BABY CHANGE TABLE ASSY	N/A	4.05	N254L4001-000
49	N254L4037-000	PANEL ASSY, BABY CHANGE TABLE	N/A	4.05	N254L4036-000
50	N254L4028-000	TOILET LID ASSY	N/A	4.07	N254L4029-000
51	N254L4029-000	TOILET SEAT ASSY	N/A	4.08	N254L4026-000
52	N254L4021-000	DISPENSER ASSY	N/A	4.09	N254L4004-000
53	N254L4044-000	WASTE CHUTE ASSY	N/A	4.13	N254L4013-000
COMBINED

Now, for some unknown reason(s), when I now run the code, it works for the recipient sheet FB1, but the recipient sheets FB2 to FB5 remain unchanged except for the fact that their heading in column C changes from "Assy P/N" to "PART NUMBER" (The heading of column A of the source Sheet)

ie

B738D ACCESS Lav MoC Overview (Assys Only)_20200727_1518.xlsm
	A	B	C	D	E
1	Function Code	Function Sub-Category	PART NUMBER	Component P/N	Tests
2	3.02	Water Heater			Structural Integrity
3					Flammability & Smoke
4					Handling & Abuse
5					Environmental Conditions
6					Endurance
7					Vibration
8					USPHS
9	3.03	Piping Potable Water			Structural Integrity
10					Flammability & Smoke
11					Handling & Abuse
12					Environmental Conditions
13					Endurance
14					Vibration
15					USPHS
FB3

I have tried to apply your original code to run individually on each recipient sheet by changing the diming of sh2 = Sheets("FB2") and matching the column references but it still won't work.

I'm at a loss once again

 

[UlyssesFR]

Some good news,

I created a brand new xlsm file and copied the code in, copied/pasted all the content (values only) of each sheet, and it runs just fine and dandy...

I still have no idea what the cause of it malfunctioning was...

 

[DanteAmor]

Glad to hear it works for you.