# Duplicate rows and fill in new columns based on master list

#### lata_m

##### New Member
Hello all,

This is my first time posting and I am hoping you can help me out with this problem in Excel.

I have a Final sheet which has locations repeated a fixed n number of times (in this case, n=2) and has its own property columns as shown below:

 Location Property3 Property4 X X Y Y Z Z XX XX

<tbody>
</tbody>

I would like to duplicate rows for individual locations and its accompanying property 3 and 4 columns as well as add two new property columns based on Master List as shown below:

 Location Property1 Property2 X a 1 X a 2 Y a 3 Y b 3 Z a 4 XX a 5 XX b 6

<tbody>
</tbody>

Modified Final sheet should look like:

 Location Property1 Property2 Property3 Property4 X a 1 X a 1 X a 2 X a 2 Y a 3 Y a 3 Y b 3 Y b 3 Z a 4 Z a 4 XX a 5 XX a 5 XX b 6 XX b 6

<tbody>
</tbody>

Locations X, Y and XX have been duplicated twice as it has had to capture the unique values in property columns in 1 and 2. Z only once as it has unique Property 1 and 2 values.

Thanks a lot!

#### sandy666

##### Well-known Member
with Power Query

 Location Property1 Property2 Location Property1 Property2 X a 1​ X a 1​ X a 2​ X a 1​ Y a 3​ X a 2​ Y b 3​ X a 2​ Z a 4​ Y a 3​ XX a 5​ Y a 3​ XX b 6​ Y b 3​ Y b 3​ Z a 4​ Z a 4​ XX a 5​ XX a 5​ XX b 6​ XX b 6​

Code:
``````[SIZE=1]// Table1
let
Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
List = Table.AddColumn(Source, "Custom", each {1..2}),
Expand = Table.ExpandListColumn(List, "Custom"),
RC = Table.RemoveColumns(Expand,{"Custom"})
in
RC[/SIZE]``````
is that what you want?

#### DanteAmor

##### Well-known Member
Hi @, welcome to the forum!

Try the following macro.
Change "Sheet1" (Sheet with locations), "Master" and "Sheet3" (Sheet with result), for the names of your sheets.

Code:
``````Sub Duplicate_rows()
Dim a() As Variant, b() As Variant, c() As Variant, i As Long, j As Long, n As Long
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Set sh1 = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
Set sh2 = Sheets("[COLOR=#ff0000]Master[/COLOR]")
Set sh3 = Sheets("[COLOR=#ff0000]Sheet3[/COLOR]")
sh3.Cells.ClearContents
a = sh1.Range("A2", sh1.Range("C" & sh1.Range("A" & Rows.Count).End(xlUp).Row))
b = sh2.Range("A2", sh2.Range("C" & sh2.Range("A" & Rows.Count).End(xlUp).Row))
ReDim c(1 To (UBound(a, 1) * UBound(b, 1)), 1 To 5)
n = 1
For i = 1 To UBound(b, 1)
For j = 1 To UBound(a, 1)
If a(j, 1) = b(i, 1) Then
c(n, 1) = b(i, 1)
c(n, 2) = b(i, 2)
c(n, 3) = b(i, 3)
c(n, 4) = a(j, 2)
c(n, 5) = a(j, 3)
n = n + 1
End If
Next
Next
sh3.Range("A2").Resize(n, 5).Value = c()
End Sub``````

#### lata_m

##### New Member
Appreciate the quick response. I will give this a try!!