I screwed this up some how, does not error nor does not return anything.

I'm testing on this workbook, if this link does not work there is a live one on Claus' last post for a test sheet of mine.

https://onedrive.live.com/?cid=9378A...121822A3%21326

Before I made changes you suggested, I ran this code on a OP linked workbook and it returned a single entry, a correct one.

The two codes I have from Claus both return two entries.

Can you see where I got it wrong here?

Howard

Sub ColumnsC_Garry()
Dim n&, j&, lLastRow
Dim v1, v2, rngBig As Range, rngSource As Range
Dim i As Long, ii As Long

Dim MyArr1 As Variant
Dim MyArr2 As Variant

Const lStartRow& = 2

Application.ScreenUpdating = False
On Error GoTo ErrExit

lLastRow = Sheets("Sheet1").Cells(Rows.Count, "C").End(xlUp).Row
MyArr1 = Sheets("Sheet1").Range("C2:C" & lLastRow)

With Sheets("Sheet2")
lLastRow = .Cells(Rows.Count, "H").End(xlUp).Row
MyArr2 = .Range("H2:H" & lLastRow)
For n = lStartRow To UBound(MyArr1)
For j = lStartRow To UBound(MyArr2)
If MyArr1(n, 1) = MyArr2(j, 1) Then

If rngBig Is Nothing Then

Set rngBig = .Range(.Cells(j, 1), .Cells(j, 26))

Else
Set rngBig = Union(rngBig, _
.Range(.Cells(j, 1), .Cells(j, 26)))
End If
End If
Next 'j
Next 'n

End With

If Not rngBig Is Nothing Then

If MyArr1(i, 1) = MyArr2(ii, 1) Then
Application.Index(rngSource, ii, 0).Copy _
Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp)(2)
Else
MsgBox "no matches found"
End If
End If

ErrExit:
Set rngBig = Nothing

Application.ScreenUpdating = True
End Sub