VBA - compare 2 columns and return matching values in another column

[tikcr]

Hi All,
I am starting my journey with VBA, so sorry when this was already posted before, but I couldn't find satisfactionary response.
What I would like to do is to compare all values from Col 1 and Col 2 starting from the second row, and if the values match (if any of the value from Column 1 is in Column 2 or other way around, they should be displayed in 'Matching values'.

Column 1	Column 2		Matching values
1QWE	2AsD
2asD	2LLO
1ZXc	1qwe
4ASZ	1zXC

In this case, I would expect values 1QWE, 2ASD, 1ZXC to be displayed in Matching values column when I press the button 'Check' with assigned macro. I would highly appreciate your support!

 

[alansidman]

Option Explicit
Option Compare Text

Sub Foo()
    Dim i As Long, lr As Long, j As Long
    lr = Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To lr
        For j = 1 To lr
            If Range("A" & i) = Range("B" & j) Then
                Range("C" & i) = Range("B" & j)
            End If
        Next j
    Next i
    MsgBox "completed"
End Sub

 

[tikcr]

Thank you so much. It works, however when i delete the results of a check from 'Matching values', add some new values in col 1 and col 2 and try to run the script again, only msg box comes in but no results are then posted in the column 'Matching values'.

 

[alansidman]

Should work. Suppose you post your starting values and then show your new values in two different tables/ranges so we can test. Please load your data using XL2BB.

 

[tikcr]

Hello, thanks for your support. In the code I changed Range("C" & i) to Range("D" & i), so I am getting results in column D.
By the way, is it possible to have the result of common values cell by cell (so if both values are in Column 1 and Column 2 then paste the common value in D2, D3, D4, etc, without empty cells in-between?)

Then what I tried after the result is visible, I deleted all results from Matching Values and I am using new data (will be copied manually from another excel sheet) but as an example, I would like to paste now new data to Column 2 from 'Paste data...'.
After that I run the macro again and would like to get new 'Matching values' which come from comparison of Col 1 and Col 2. For some reason it does not work for me and only shows 1 common value between two columns which is wrong...

Here is the data I am using:

columns compare.xlsx
	A	B	C	D	E	F	G	H
1	Column 1	Column 2		Matching values		after the check, press button 'Clear' and delete all results from 'Matching values'		Paste new data into Column 2 and check matching values
2	ZAU000016271	ZAU000002917						ZAU000014474
3	ZAU000002891	ZAU000017097						ZAU000017097
4	ZAU000002909	ZAU000002917						ZAU000012742
5	ZAU000002917	ZAU000012742						ZAU000002891
6	ZAU000002933	ZAU000012718						ZAU000012601
7	ZAE400000010	ZAU000008096						ZAU000012353
8	ZAU000008096	ZAU000016271						ZAU000013716
9	ZAU000008187	ZAU000013716						ZAU000002891
10	ZAU000008229	ZAU000013724						ZAU000012601
11	ZAU000016792	ZAU000012346						ZAU000012346
12		ZAU000012353						ZAU000008096
13		ZAU000012551						ZAU000008096
14		ZAU000012601						ZAU000012353
15		ZAU000014011						ZAU000016271
16		ZAU000014029
17		ZAU000012965
18		ZAU000012957
19		ZAU000014474
20		ZAU000017055
21		ZAU000013872
22		ZAU000008096
23		ZAU000012353
24		ZAU000016271
25		ZAU000002891
Arkusz1

 

[alansidman]

Cannot replicate your issue. I delete the data in Columns A and D and then put new data in Column A. No issues.
Here is the new code to show no blank spaces

Option Explicit
Option Compare Text

Sub Foo()
    Dim i As Long, lr As Long, j As Long, lr2 As Long
    lr = Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To lr
        For j = 1 To lr
        lr2 = Range("D" & Rows.Count).End(xlUp).Row
            If Range("A" & i) = Range("B" & j) Then
                Range("D" & lr2 + 1) = Range("B" & j)
            End If
        Next j
    Next i
    MsgBox "completed"
End Sub

 

[jolivanes]

Another way if I understand your requirement right.

Sub Maybe()
Dim lr1 As Long, lr2 As Long, i As Long
lr1 = Cells(Rows.Count, 1).End(xlUp).Row
lr2 = Cells(Rows.Count, 2).End(xlUp).Row
    For i = 2 To lr2
        If WorksheetFunction.CountIf(Range("A2:A" & lr1), Range("B" & i)) <> 0 Then Cells(Rows.Count, 4).End(xlUp).Offset(1).Value = Range("B" & i).Value
    Next i
End Sub

Here I assumed Column B to be the shortest data Column. Change the references so you'll loop through the shortest column if different setup.