Duplicate rows and fill in new columns based on master list

lata_m

New Member
Joined
Nov 12, 2019
Messages
3
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:


LocationProperty3Property4
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:


LocationProperty1Property2
Xa1
Xa2
Ya3
Yb3
Za4
XXa5
XXb6

<tbody>
</tbody>


Modified Final sheet should look like:


LocationProperty1Property2Property3Property4
Xa1
Xa1
Xa2
Xa2
Ya3
Ya3
Yb3
Yb3
Za4
Za4
XXa5
XXa5
XXb6
XXb6

<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
Joined
Oct 24, 2015
Messages
3,307
with Power Query

LocationProperty1Property2LocationProperty1Property2
Xa
1​
Xa
1​
Xa
2​
Xa
1​
Ya
3​
Xa
2​
Yb
3​
Xa
2​
Za
4​
Ya
3​
XXa
5​
Ya
3​
XXb
6​
Yb
3​
Yb
3​
Za
4​
Za
4​
XXa
5​
XXa
5​
XXb
6​
XXb
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
Joined
Dec 3, 2018
Messages
7,891
Office Version
2007
Platform
Windows
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
 

Forum statistics

Threads
1,078,393
Messages
5,339,923
Members
399,340
Latest member
JasonT903

Some videos you may like

This Week's Hot Topics

Top