Excel macro to lookup 'exact' value and copy corresponding field

Hi Experts,

I got this excellent macro from MSmax:

Private Sub lookup()

Dim wb As Workbook
Dim sh1 As Worksheet, sh2 As Worksheet
Dim lr1 As Long, lr2 As Long
Dim i As Long, j As Long
Dim count As Long

Set wb = ThisWorkbook
'Change Sheetnames if needed
Set sh1 = wb.Worksheets("Sheet1")
Set sh2 = wb.Worksheets("Sheet2")

lr1 = sh1.Range("A" & Rows.count).End(xlUp).Row
lr2 = sh2.Range("A" & Rows.count).End(xlUp).Row

For i = 2 To lr2
    count = 0
    For j = 1 To lr1
        If InStr(1, sh1.Cells(j, 3).Value, sh2.Cells(i, 1).Value, vbBinaryCompare) > 0 Then
            count = count + 1
            sh2.Cells(i, 4 + count).Value = sh1.Cells(j, 1).Value
        End If
    Next j
Next i

End Sub
 

For each value found in sheet2 column A, it checks if string is found in sheet1 column C, if found copies corresponding value of sheet1 column A back to sheet2.

The problem here is that the compare does not check the "exact" string,
so if
AAA-BBB-CCC is the value iin sheet 2 column A to be searched for in sheet 1,  
what is returned is the corresponding values of:
AAA-BBB-CCC and
AAA-BBB-CCC-DDD and
AAA-BBB-CCC-DDD-EEE etc

Whereas only corresponding value of exactely 'AAA-BBB-CCC' is needed.

Do you see a way of changing this? Maybe this makes 'vbBinaryCmpare' not suitable for this?

Thank you for helping.

W.
 
WatnogAsked:
Who is Participating?
 
Rory ArchibaldConnect With a Mentor Commented:
Change the Instr line to:
           If sh1.Cells(j, 3).Value = sh2.Cells(i, 1).Value Then

Open in new window

and it should require an exact full match.
0
 
WatnogAuthor Commented:
Thank you Rorya.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.