Find value in another sheet and get cell value in same row

[kelseyvdh]

Hi everyone, I'm struggling to solve VBA macro. I've attached an example to explain what I want.

In the example there're two sheets with two lists. I want to get the value of column A in Sheet 1 and look it up Sheet 2. Then I want to copy the value of column B in Sheet 2 to column B in Sheet 1. It has to be the value in the same row.

So,
Sheets("Sheet1").Range("B2") should be "3"
Sheets("Sheet1").Range("B3") should be "4"
Sheets("Sheet1").Range("B4") should be "1"
Sheets("Sheet1").Range("B5") should be "2"
Sheets("Sheet1").Range("B6") should be "2"


Can you guys help me with that? Many thanks in advance!

[JKwan]

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

[kelseyvdh]

Hi JKwan,

Thank you for your help! Works like a charm in the example workbook! I'll try to add it to my real sheet.

Many thanks!

[p45cal]

Not sure if I've missed the point here but what about a hyper-simple lookup formula?:
In cell B2 of FirstSheet:
=VLOOKUP(A2,SecondSheet!$A$1:$B$6,2,FALSE)
copied down to B6?