Excel macro to lookup 'exact' value and copy corresponding field
Posted on 2011-02-14
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
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,
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:
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.