Hi Howard,

Am Thu, 25 Jun 2015 17:57:20 -0700 (PDT) schrieb L. Howard:

Nme's CAN occur more than once in sheets Input, column A.

Also, if no match found on Output sheet, the "no match" is listed as a result with the resize data cells blank.

Yellow cells on Input sheet have no match on Output sheet and ARE listed in Column C returns.

try (in a standard module):

Sub Nme_Find_Exp_New()
Dim rngFound As Range
Dim varTmp As Variant, varCheck As Variant
Dim myDic As Object, i As Long
Dim FirstAddress As String

varTmp = Sheets("Input").Range("A2:A" & Cells(Rows.Count,
"A").End(xlUp).Row)
Set myDic = CreateObject("Scripting.Dictionary")
For i = LBound(varTmp) To UBound(varTmp)
myDic(varTmp(i, 1)) = varTmp(i, 1)
Next
varCheck = myDic.items

For i = LBound(varCheck) To UBound(varCheck)

Set rngFound = Sheets("Output").Range("A:A").Find(What:=varCheck( i), _
LookIn:=xlValues, _
LookAt:=xlWhole)

If Not rngFound Is Nothing Then

FirstAddress = rngFound.Address
Do

Sheets("Input").Cells(Rows.Count, 3).End(xlUp)(2) _
.Resize(1, 42).Value = rngFound.Resize(1, 42).Value

Set rngFound = Sheets("Output").Range("A:A").FindNext(rngFound)
Loop While Not rngFound Is Nothing And rngFound.Address <
FirstAddress
Else
Sheets("Input").Cells(Rows.Count, 3).End(xlUp)(2) = varCheck(i)
Sheets("Input").Cells(Rows.Count, 3).End(xlUp).Offset(, 1) = "no
Match"
End If
Next

End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional