Copy and Paste and Loop - Consolidate 2 worksheets

[ShuStar]

Hi all,

Effectively merging two sheets onto a new sheet where ID is the common identifier between them.

I am trying to create a macro which will copy a row from Tab 1 and paste it into Consolidated Tab, then go into Tab2 and find the rows that match the ID and paste the respective columns into Consolidated Tab.

It should be a loop and do this for all the Rows in Tab 1 . If it can’t find a match to copy over from Tab 2, it should just say “No Match to Raw Data” or "No Match" or something of that sort.

So three sheets being used in total:
*Tab 1 – Raw Data2 where ID is the key
*Tab 2 – Matrix sheet where ID matches to Raw Data2
*Consolidated sheet - where end output should be (ie the consolidation of data from RawData and Matrix)



Example:

In Tab 1 (Raw Data2 sheet) Start from A3 – take this and the respective columns and paste into Consolidated Sheet. ie ID 12345

Then find all the IDs 12345 in Tab 2 (Matrix sheet) and copy these over to Consolidated sheet

Consolidated Sheet should now look like below (left purple side is from Raw Data and right side is from Matrix):

End Output: Now do the same for all the remaining rows IDs in Tab 1 (Raw Data 2 sheet), where final output should look something like:

Note: no colour coding or formatting is needed in the macro, I just did this to try make easier to highlight what it is that I am trying to achieve.

A copy of the workbook can be found here Mapping Filter Doc

Would be ever so grateful for anyones support here. Thank you Gurus.

 

[ShuStar]

Open to any suggestions for what the macro should look like. Would be grateful for anyone's support.

 

[alansidman]

Using Power Query, which is an excel addin for version 2010. If you are using a later version, ie. 2016 or later, it can be found on the Data Tab and is now called Get and Transform. Bring each of the tables into PQ. Then join them on an left inner join to get the following.

Mapping Filter.xlsm
	A	B	C	D	E	F	G	H	I
1	ID	Section	Beginning Date	Geo Range Start	Geo Range To	Description	Table2.Names	Table2.Count	Table2.Concat
2	12345	Lisbon	8/1/2020	A	B	acavsdvdf	John	3	Nectarines, Apricots, Peaches
3	12345	Lisbon	8/1/2020	A	B	acavsdvdf	Barry	2	Nectarines, Peaches
4	12345	Lisbon	8/1/2020	A	B	acavsdvdf	Tom	3	Nectarines, Apricots, Peaches
5	12380	London	8/1/2020	A	B	asdfgh	Sarah	2	Apricots, Peaches
6	12380	London	8/1/2020	A	B	asdfgh	Jane	2	Apricots, Peaches
7	12380	London	8/1/2020	A	B	asdfgh	Kevin	1	Apricots
8	12415	Madrid	8/1/2020	A	B	afgdfhdg	Jack	1	Apricots
9	12415	Madrid	8/1/2020	A	B	afgdfhdg	Jill	1	Apricots
10	12450	Paris	8/6/2020	B	D	xcvxcv
11	12485	Frankfurt	8/11/2020	B	D	vdbcsxcas	Gill	3	Nectarines, Apricots, Peaches
12	12485	Frankfurt	8/11/2020	B	D	vdbcsxcas	Barry	3	Nectarines, Apricots, Peaches
13	12485	Frankfurt	8/11/2020	B	D	vdbcsxcas	Luke	3	Nectarines, Apricots, Peaches
14	12485	Frankfurt	8/11/2020	B	D	vdbcsxcas	Alex	3	Nectarines, Apricots, Peaches
15	12520	Munich	8/16/2020	B	D	cvxcbdfnbf
16	12555	Tokyo	9/15/2020	C	C	cvxcvxcb
17	12590	Delhi	10/15/2020	C	C	acavsdvdf
18	12625	New York	11/14/2020	C	C	asdfgh
19	12660	Lisbon	12/14/2020	A	B	afgdfhdg
20	12695	London	1/13/2021	A	B	xcvxcv
21	12730	Madrid	2/12/2021	A	B	vdbcsxcas
22	12765	Paris	8/1/2020	B	B	cvxcbdfnbf
23	12800	Frankfurt	8/6/2020	B	B	cvxcvxcb
24	12835	Munich	8/11/2020	B	B	acavsdvdf
25	12870	Tokyo	8/16/2020	C	D	asdfgh
26	12905	Delhi	9/15/2020	C	D	afgdfhdg
27	12940	New York	10/15/2020	C	D	xcvxcv
Sheet1

 

[ShuStar]

Hi - thanks for the reply, will look into power query but ideally was hoping for a macro code to execute it I'm afraid.

 

[DanteAmor]

Try this:

Sub Consolidate_2_worksheets()
  Dim a As Variant, b As Variant, c As Variant
  Dim dic As Object
  Dim i As Long, j As Long, k As Long, m As Long
  
  a = Sheets("Raw Data 2").Range("A3:F" & Sheets("Raw Data 2").Range("A" & Rows.Count).End(3).Row).Value2
  b = Sheets("Matrix").Range("A3:D" & Sheets("Matrix").Range("A" & Rows.Count).End(3).Row).Value2
  ReDim c(1 To UBound(a, 1) + UBound(b, 1), 1 To 10)
  Set dic = CreateObject("Scripting.Dictionary")
  
  For i = 1 To UBound(b, 1)
    If Not dic.exists(b(i, 1)) Then
      dic(b(i, 1)) = i
    End If
  Next
  
  For i = 1 To UBound(a, 1)
    If Not dic.exists(a(i, 1)) Then
      k = k + 1
      For j = 1 To 6
        c(k, j) = a(i, j)
      Next
      c(k, 7) = "No Match"
    Else
      For m = dic(a(i, 1)) To UBound(b, 1)
        If b(m, 1) = a(i, 1) Then
          k = k + 1
          For j = 1 To 6
            c(k, j) = a(i, j)
          Next
          For j = 7 To 10
            c(k, j) = b(m, j - 6)
          Next
        Else
          Exit For
        End If
      Next
    End If
  Next
  
  Sheets("Consolidated").Range("A3").Resize(k, 10).Value = c
End Sub

 

[DanteAmor]

Here a smaller version, in case there are few records.

Sub Consolidate_2_worksheets_2()
  Dim sh3 As Worksheet
  Dim c As Range, f As Range, lr As Long, n As Long

  Set sh3 = Sheets("Consolidated")
  For Each c In Sheets("Raw Data 2").Range("A3", Sheets("Raw Data 2").Range("A" & Rows.Count).End(3))
    Set f = Sheets("Matrix").Range("A:A").Find(c, , xlValues, xlWhole, , , False)
    n = WorksheetFunction.CountIf(Sheets("Matrix").Range("A:A"), c.Value)
    If n = 0 Then n = 1
    lr = sh3.Range("A" & Rows.Count).End(3).Row + 1
    sh3.Range("A" & lr).Resize(n, 6).Value = c.Resize(1, 6).Value
    If f Is Nothing Then sh3.Range("G" & lr) = "No Match" Else sh3.Range("G" & lr).Resize(n, 4).Value = f.Resize(1, 4).Value
  Next
End Sub

 

[ShuStar]

Hi DanteAmor - nailed it! Thank you very much for this, both working as expected. Really appreciate it!! This will now enable to hopefully finish the overall macro! Thanks!

 

[ShuStar]

Hi DanteAmor - i was going to ask if you could help explain your macro to me please? I get that it does what is needed, but I wanted to develop my knowledge on macros a bit more and try understand what the lines of code are doing. Would that be ok for you to explain?

 

[DanteAmor]

Would that be ok for you to explain?

With pleasure:

Sub Consolidate_2_worksheets_2()
  Dim sh3 As Worksheet
  Dim c As Range, f As Range, lr As Long, n As Long

  Set sh3 = Sheets("Consolidated")
  'For each data in the range A3 and up to the last cell with data from column A.
  For Each c In Sheets("Raw Data 2").Range("A3", Sheets("Raw Data 2").Range("A" & Rows.Count).End(3))
    'Find the data in the Matrix sheet, column A
    Set f = Sheets("Matrix").Range("A:A").Find(c, , xlValues, xlWhole, , , False)
    'Counts the number of data that exists in the Matrix sheet column A
    n = WorksheetFunction.CountIf(Sheets("Matrix").Range("A:A"), c.Value)
    'If there is no data then n = 0, then I convert n = 1 to copy the row and put "No match"
    If n = 0 Then n = 1
    'Gets the last row with data from the Consolidate sheet and Add 1
    lr = sh3.Range("A" & Rows.Count).End(3).Row + 1
    'The consolidate sheet, in column A and in the last row,
    'resize the number of rows according to the value of n, that is,
    'the number of times it found the data and 6 columns.
    'In that range it receives the value of the sheet "raw data2"
    'In this case, it starts at the data 'c' and the number of rows grows according to n and 6 columns.
    sh3.Range("A" & lr).Resize(n, 6).Value = c.Resize(1, 6).Value
    'If 'f' is nothing then I add the text "no match" in column G.
    'Else, in column G put the values, in the same way the number of rows grows according to the value n and 4 columns.
    If f Is Nothing Then sh3.Range("G" & lr) = "No Match" Else sh3.Range("G" & lr).Resize(n, 4).Value = f.Resize(1, 4).Value
  Next
End Sub

 

[ShuStar]

Thank you so much!! Makes a lot of sense now! Appreciate it