Check condition which involves matching filtered tables and copying it in new sheet

[amrita17170909]

I have a filtered table named "Table 3".

I have to match filtered values from column A of "Table 3" to column A of "Table 2" and if the condition is met copy the entire row to a new sheet named "Table 4"

I have tried the below code without any success

Sub Copy_data_to_report()

Application.ScreenUpdating = False

lastRow = Worksheets("Table 3").Cells(Rows.Count, 1).End(xlUp).Row

nextRow = 2
      
        For thisRow = 1 To lastRow
      
           If Worksheets("Table 3").Cells(thisRow, 1).Value = Worksheets("Table 2").Cells(thisRow, 1).Value Then
         
               Worksheets("Table 2").Rows(thisRow).Copy

               Worksheets("Table 4").Activate

               B = Worksheets("Table 4").Cells(Rows.Count, 1).End(xlUp).Row

               Worksheets("Table 4").Cells(B + 1, 1).Select

               Worksheets("Table 4").Paste
             
               nextRow = nextRow + 1
             
            End If
                  
   Next

Application.CutCopyMode = False

End Sub

 

[DanteAmor]

Try something like this

the "table 3" sheet is filtered

Book1
	A	B	C
1
2
3
4	A1	b1	c1
5	A2	b2	c2
6	A3	b3	c3
9	A6	b6	c6
12	A9	b9	c9
Table 3

the "table 4" sheet is NOT filtered

Book1
	A	B	C
5	A5	b5	c5
6	A15	b6	c6
7	A3	b7	c7
8	A8	b8	c8
9	A9	b9	c9
10	A10	b10	c10
11	A11	b11	c11
12	A12	b12	c12
Table 4

The macro looks for the values in column A of the "table 3" sheet within column A of the "table 4" sheet, if the value exists, then copy the row from the "table3" to the "table4".
In my example the values A3 and A9 are in the "table3" and also in the "table4", the result is in the "table4":

Book1
	A	B	C
5	A5	b5	c5
6	A15	b6	c6
7	A3	b7	c7
8	A8	b8	c8
9	A9	b9	c9
10	A10	b10	c10
11	A11	b11	c11
12	A12	b12	c12
13	A3	b3	c3
14	A9	b9	c9
Table 4

 

[amrita17170909]

Hi,

Thanks so much for your help.

I hope this explains the problem a bit more.

I have the below Table 3 which has filtered values . This table has been filtered on a value column and only shows rows of data above a certain threshold.I have to use UserID to extract data from Table 2.

For e.g A1 under UserID has 2 rows under Table 3 whereas Table 2 has 3 rows and hence the final output (Table 4) should have 3 rows.

Table 3
User ID	Program	Value
A1	Abc	100000​
A1	Xyz	20000​
A3	BB	2500​
A3	Abc	2500​
B1	Xyz	300​
B3	Abc	10​

Table 2 : Table 2 has list of all rows of data. The final output should look like Table 4

Table 2
User ID	Program	Value
A1	Abc	100000​
A1	Xyz	20000​
A1	AA	30000​
A2	VV	20​
A3	BB	-2500​
A3	Abc	2500​
B1	Xyz	300​
B1	AA	20​
B2	AA	-50​
B2	Abc	10​
B3	Abc	10​
B3	Abc	-80​

Table 4: Final Output

Table 4
User ID	Program	Value
A1	Abc	100000​
A1	Xyz	20000​
A1	AA	30000​
A3	BB	-2500​
A3	Abc	2500​
B1	Xyz	300​
B1	AA	20​
B3	Abc	10​
B3	Abc	-80​

I hope this makes sense

Amrita

 

[DanteAmor]

I don't see the rows or the columns. I will assume that it is columns A, B and C and that the headings begin are in row 1 and the data begins in row 2 (in all sheets).

If the header is, for example, in row 4, then change in the macro where it says "A1 by "A4

Sub Generate_table4_v3()
  Dim sh3 As Worksheet, sh2 As Worksheet, dic As Object
  Dim c As Range, a() As Variant, b() As Variant, i As Long, j As Long
 
  Set sh3 = Sheets("Table 3")
  Set sh2 = Sheets("Table 2")
  Set dic = CreateObject("Scripting.Dictionary")
 
  For Each c In sh3.Range("A1", sh3.Range("A" & Rows.Count).End(xlUp))
    If c.EntireRow.Hidden = False Then dic(c.Value) = Empty
  Next
 
  j = 1
  a = sh2.Range("A1:C" & sh2.Range("A" & Rows.Count).End(xlUp).Row).Value2
  ReDim b(1 To UBound(a), 1 To 3)
  For i = 1 To UBound(a)
    If dic.exists(a(i, 1)) Then
      b(j, 1) = a(i, 1)
      b(j, 2) = a(i, 2)
      b(j, 3) = a(i, 3)
      j = j + 1
    End If
  Next
  Sheets("Table 4").Range("A1").Resize(j - 1, 3).Value = b()
End Sub

 

[amrita17170909]

hi Dante Amor,

Thanks for the code but I should have clarified that the tables have columns from A to AB.

I am only bringing across columns A,B and C at this stage .

Are you able to provide an amended code to bring across all columns ?

Thanks,

Amrita

 

[DanteAmor]

Did you try the macro?
Is the ID always in column A?

Please Note
-----------------------
One thing you must keep in mind when you ask a question in a forum... the people you are asking to help you know absolutely nothing about your data, absolutely nothing about how it is laid out in the workbook, absolutely nothing about what you want done with it and absolutely nothing about how whatever it is you want done is to be presented back to you as a result... you must be very specific about describing each of these areas, in detail, and you should not assume that we will be able to "figure it out" on our own. Remember, you are asking us for help... so help us to be able to help you by providing the information we need to do so, even if that information seems "obvious" to you (remember, it is only obvious to you because of your familiarity with your data, its layout and the overall objective for it).

 

[amrita17170909]

Yes I tried the macro and it is working perfectly in terms of logic.

ID is always going to be in column A and the output picked up the correct ID's from Table 2 .

I just want to ensure that all the column values from A to AB are picked up in the final table i.e Table 4.

I hope that makes sense. I will ensure that I am as clear as possible going forward.

Apologies for the confusion

 

[DanteAmor]

Try this

Sub Generate_table4_v4()
  Dim sh3 As Worksheet, sh2 As Worksheet, dic As Object, r As Range
  Dim c As Range, a() As Variant, i As Long, lr As Long
 
  Set sh3 = Sheets("Table 3")
  Set sh2 = Sheets("Table 2")
  Set dic = CreateObject("Scripting.Dictionary")
 
  For Each c In sh3.Range("A1", sh3.Range("A" & Rows.Count).End(xlUp))
    If c.EntireRow.Hidden = False Then dic(c.Value) = Empty
  Next
 
  lr = sh2.Range("A" & Rows.Count).End(xlUp).Row
  Set r = sh2.Range("A" & lr + 1)
  a = sh2.Range("A1:C" & lr).Value2
  For i = 1 To UBound(a)
    If dic.exists(a(i, 1)) Then Set r = Union(r, sh2.Range("A" & i))
  Next
  r.EntireRow.Copy Sheets("Table 4").Range("A1")
End Sub

 

[amrita17170909]

It works perfectly . Thank you so much!

 

[DanteAmor]

It works perfectly . Thank you so much!

Im glad to help you, thanks for the feedback.