Extract and List Matching Cells - vba

Question

I'm trying to compare two columns (A and B) containing company names, find any names that are an exact match, and list them in column C. With the code below I don't get an error but nothing happens. If someone could point me in the right direction it would be appreciated.
Sub match()
Dim LastRow As Integer
Dim i As Integer
LastRow = Range("B" & Rows.Count).End(xlUp).Row
For i = 3 To LastRow
Set Row2Name = Sheets("Sheet1").Cells(i, 2)
Set Row1Name = Sheets("Sheet1").Cells(i, 1)
Set MatchName = Sheets("Sheet1").Cells(i, 1)
If Cells(i, 2) = Row1Name Then
Row2Name.Copy
MatchName.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Next i
End Sub

Answer 1

Here is a tidied version with correctly using column C i.e.
Set MatchName = Sheets("Sheet1").Cells(i, 3) if column C.
Code:
Option Explicit
Public Sub matching()
Dim LastRow As Long, i As Long, Row2Name As Range, Row1Name As Range, MatchName As Range
With Worksheets("Sheet1")
LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
For i = 3 To LastRow
Set Row2Name = .Cells(i, 2)
Set Row1Name = .Cells(i, 1)
Set MatchName = .Cells(i, 3)
If .Cells(i, 2) = Row1Name Then
Row2Name.Copy
MatchName.PasteSpecial Paste:=xlPasteValues
End If
Next i
End With
End Sub
Which is essentially this:
Option Explicit
Public Sub matching()
Dim i As Long
Application.ScreenUpdating = False
With Worksheets("Sheet1")
For i = 3 To .Range("B" & .Rows.Count).End(xlUp).Row
If .Cells(i, 1) = .Cells(i, 2) Then .Cells(i, 3) = .Cells(i, 2)
Next i
End With
Application.ScreenUpdating = True
End Sub
For large numbers of rows you could do this all in memory using an array.
Public Sub matching()
Dim arr(), i As Long
With Worksheets("Sheet1")
.Columns(3).ClearContents
arr = .Range("A3:C" & .Range("B" & .Rows.Count).End(xlUp).Row).Value
For i = LBound(arr, 1) To UBound(arr, 1)
If arr(i, 1) = arr(i, 2) Then arr(i, 3) = arr(i, 2)
Next i
.Cells(3, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End With
End Sub

Answer 2

Try to process in memory with arrays and avoid loops when faster 'prove existence' methods are available..
Sub matchComps()
Dim i As long, j As long, arrA as variant, arrB as variant, arrC as variant
with workSheets("Sheet1")
arrA = .range(.cells(3, "A"), .cells(.rows.count, "A").end(xlup)).value2
arrb = .range(.cells(3, "B"), .cells(.rows.count, "B").end(xlup)).value2
redim arrc(1 to application.min(ubound(arra, 1) ,ubound(arrb, 1)), 1 to 1)
for i= lbound(arra, 1) to ubound(arra, 1)
if not iserror(application.match(arra(i, 1), arrb, 0)) then
j=j+1
arrc(j,1) = arra(i, 1)
end if
next i
.cells(3, "C").resize(ubound(arrc, 1), ubound(arrc, 2)) = arrc
end with
End Sub