Duplicate rows based on call value and and extra column

[arendberg]

Hey Guys,

Would love some help with the below sheets. I want to duplicate the rows in the Input sheet based on the number of adults and childeren, columns C and D. For every duplicated row there needs to be an extra column showing "Adult" for every adult and "Child" for every child.

Input example

Example.xlsx
	A	B	C	D	E	F	G	H
1	arrival	departure	children	adults	travel_purpose	nationality	date_of_birth	country
2	1/21/24	1/26/24	0	2	private_trip	CH	7/12/90	CH
3	1/22/24	1/26/24	2	4	private_trip	DE	5/9/79	CH
4	1/22/24	1/27/24	0	1	private_trip	CH	11/2/90	CH
5	1/22/24	2/3/24	1	3	private_trip	CH	2/7/54	CH
6	1/22/24	1/24/24	0	1	private_trip	CH	3/20/94	CH
Input

Output example

Example.xlsx
	A	B	C	D	E	F	G	H	I
1	arrival	departure	children	adults	travel_purpose	nationality	date_of_birth	country	Class
2	1/21/24	1/26/24	0	2	private_trip	CH	7/12/90	CH	Adult
3	1/21/24	1/26/24	0	2	private_trip	CH	7/12/90	CH	Adult
4	1/22/24	1/26/24	2	4	private_trip	DE	5/9/79	CH	Adult
5	1/22/24	1/26/24	2	4	private_trip	DE	5/9/79	CH	Adult
6	1/22/24	1/26/24	2	4	private_trip	DE	5/9/79	CH	Adult
7	1/22/24	1/26/24	2	4	private_trip	DE	5/9/79	CH	Adult
8	1/22/24	1/26/24	2	4	private_trip	DE	5/9/79	CH	Child
9	1/22/24	1/26/24	2	4	private_trip	DE	5/9/79	CH	Child
10	1/22/24	1/27/24	0	1	private_trip	CH	11/2/90	CH	Adult
11	1/22/24	2/3/24	1	3	private_trip	CH	2/7/54	CH	Adult
12	1/22/24	2/3/24	1	3	private_trip	CH	2/7/54	CH	Adult
13	1/22/24	2/3/24	1	3	private_trip	CH	2/7/54	CH	Adult
14	1/22/24	2/3/24	1	3	private_trip	CH	2/7/54	CH	Child
15	1/22/24	1/24/24	0	1	private_trip	CH	3/20/94	CH	Adult
Output

 

[skillilea]

Do you have this function in the same module. ie. Put it under the ExtendRows Sub. It is private so it needs to be in the same module

Private Sub WriteRecord(destRng As Range, rng As Range, recCnt As Long, rowNum As Long, theClass As String)
    destRng.Offset(recCnt, 0) = rng.Offset(rowNum, 0).Value
    destRng.Offset(recCnt, 1) = rng.Offset(rowNum, 1).Value
    destRng.Offset(recCnt, 2) = rng.Offset(rowNum, 2).Value
    destRng.Offset(recCnt, 3) = rng.Offset(rowNum, 3).Value
    destRng.Offset(recCnt, 4) = rng.Offset(rowNum, 4).Value
    destRng.Offset(recCnt, 5) = rng.Offset(rowNum, 5).Value
    destRng.Offset(recCnt, 6) = rng.Offset(rowNum, 6).Value
    destRng.Offset(recCnt, 7) = rng.Offset(rowNum, 7).Value
    destRng.Offset(recCnt, 8) = rng.Offset(rowNum, 8).Value
    destRng.Offset(recCnt, 9) = theClass
End Sub

 

[arendberg]

Ah ok I didn't understand that, it works now!!

Thank you for all the help.

 

[skillilea]

You are absolutely welcome