Extract and List Matching Cells

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 err

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