give this a go
Option Explicit
Sub GetValues()
Dim Found As Range
Dim lRow As Long
Dim WS As Worksheet
Set WS = ThisWorkbook.Worksheets("SecondSheet")
With ActiveSheet
For lRow = 2 To 6
Set Found = Find_All(.Cells(lRow, "A"), WS.Range("A2:A6"), , xlWhole)
If Found Is Nothing Then
.Cells(lRow, "A").Interior.Color = vbRed
Else
.Cells(lRow, "B") = Found.Offset(0, 1)
End If
Next lRow
End With
End Sub
Function Find_All(Find_Item As Variant, Search_Range As Range, _
Optional LookIn As XlFindLookIn = xlValues, _
Optional LookAt As XlLookAt = xlPart, _
Optional MatchCase As Boolean = False) As Range
Dim c As Range
Dim firstAddress As String
Set Find_All = Nothing
With Search_Range
Set c = .Find( _
what:=Find_Item, _
LookIn:=LookIn, _
LookAt:=LookAt, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=MatchCase, _
searchformat:=False) 'Delete this term for XL2000 and earlier
If Not c Is Nothing Then
Set Find_All = c
firstAddress = c.Address
Do
Set Find_All = Union(Find_All, c)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Function