When cell from range A exists in Range B then copy both into rows below tables-CodePudding

I have two small tables.

First one contains 3 columns and 5 rows. Second one contains 4 columns and 5 rows.

When cell value from first table (column 3) is equal to cell value from second (table column 3,4) then I need to copy ID's of those cells (columns 1 both tables) let say 10 rows below so I get another small tables where I would see all ID's from both tables which are equal.

I could do that with IF statement but It's lot of job and I'm looking for better solution.

I developed that simply code but I need to repeat it again and again...

Sub test()

    If Range("C6").Value = Range("G6").Value Then
        Range("B6").Copy
        Range("B20").PasteSpecial
        Range("F6").Copy
        Range("C20").PasteSpecial
    End If

End Sub

Edit

I have duplicates in table A and I want that if for example value ROL appears two times in table its ID should be copied two times as well.

Dim cl As Range 

For Each cl In Range("C6:C15")
    If cl.Value = "CHEM" Then
        cl.Offset(0, 2).Copy
        Range("B25").PasteSpecial
        Range("C25").Value = 1
    End If
    If cl.Value = "ROL" Then
        cl.Offset(0, 2).Copy
        Range("B26").PasteSpecial
        Range("C26").Value = 2 
    End If 
Next

What you wrote is exactly what I need to do. I tried to finish code given by you but I do something wrong. Once both values match I need copy their ID's and paste into the cells B25 and C25 next to B26 and C26 etc. Look at the code below please. I get error message with cla.Offset(0,-2).Copy (Application defined or object defined). How can I paste here the code as it looks like you did it? –

Dim cla As Range
Dim clb As Range

For Each cla In Range("A6:C15") 'first range of values
    For Each clb In Range("E7:G13") 'second range of values
        If cla.Value = clb.Value Then
            clb.Offset(0, -2).Copy
            cla.Offset(0, -2).Copy
            Range("B25").PasteSpecial
            Range("C25").PasteSpecial
        End If
    Next
Next

So this is how the code looks now. Unfortunately, what is copied is not correct. I will explain.

In range 1 there is value INF with ID 1. In range 2 there is value INF with ID 3.

Once both values meet then output should be 1,3. Now is 1,1. Additionally value INF is copied as well (shouldn't be copied).

Dim cla As Range
Dim clb As Range

Dim R As Long 'declare variable that will refer to a row value
R = 25        'and initialize R to the first row, where to output pairs when found

For Each cla In Range("A6:C15") 'first range of values
    For Each clb In Range("E7:G13") 'second range of values
        If cla.Value = clb.Value Then
            Cells(R, 2) = cla.Value
            Cells(R, 3) = clb.Value
            R = R   1
        End If
    Next
Next

Here you have two tables. Below tables you can see what the output should be.

Table 1                     Table 2
ID Surname   Lesson type    ID  Lesson name Lesson Type
1  Smith      INF           1    Chemia       CHEM
2  Kowalski   ROL           2    Agro         ROL
3  Smith      FIZ           3    Infor        INF
4  Kowalski   CHEM          4    Fizyka       FIZ
5  Smith      EKON          5    Matem        MAT
6  Kowalski   ROL           6    Ekonom       EKON
7  Smith      ROL           7    Maszyny      FIZ 
8  Kowalski   FIZ
9  Smith      MAT
10 Kowalski   EKON

ID table1 ID table2
   1         3
   2         2
   3         4           
   3         7
   4         1
   5         6
   6         2

etc...

CodePudding user response：

I'm sure the intention is not to enter actual values into your code as you show in comments.

Regarding the loop(s) arrangement, consider to read one value from table A, then check that value against every value in table B. Then again read next value from A, and check again against all values in B and so on... This requires that the loops are nested

For Each cla In Range("A6:C10") 'first range of values
    For Each clb In Range("E6:H10") 'second range of values
        If cla.Value = clb.Value Then
            'hit found, copy (or move) values to output area,
            'increment output area line number
        End If
    Next
Next

When a match is found, copy (or move if that is your task) the value(s) to the output area. Continue looping until the last item of both A and B.

Addition

You do know how to refer to cells with the Range() object. Another way is to use Cells(): Cells(Row, Column) where Row and Column are expressions resolving to numeric values. This is handy when you need to refer to row or column with indices.

So, if your output area is in columns B and C starting on row 25, you can do, before the For loop(s):

Dim R As Long 'declare variable that will refer to a row value
R = 25        'and initialize R to the first row, where to output pairs when found

In the code between If cla.Value = clb.Value Then and End If remove what you currently have and add ...

            Cells(R, 2) = cla.Value 
            Cells(R, 3) = clb.Value
            R = R   1

... to copy the values and increment R in preparation for an eventual other match later.

Note that the output columns are constants (2 and 3) as they don't need to change.

Final edit:

Ok, now that you posted actual data, I understand your Offset(0, -2) additions earlier. That was correct as you needed the ID and not the Lesson type. It was the Paste to a fixed range, that made it not to work as intended. You can completely avoid the copy - paste and instead assign the values directly to correct cells.

Anyways, with the following For loops and Lesson type in columns "C" and "F" I get the result below.

For Each cla In Range("C7:C16")
    For Each clb In Range("F7:F13")
        If cla.Value = clb.Value Then
            Cells(R, 2) = cla.Offset(0, -2)
            Cells(R, 3) = clb.Offset(0, -2)
            R = R   1
        End If
    Next
Next

Result in columns 2 and 3 (or B and C)

ID table1 ID table2
        1        3
        2        2
        3        4
        3        7
        4        1
        5        6
        6        2
        7        2
        8        4
        8        7
        9        5
       10        6