Watnog

asked on

# 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.

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.

ASKER CERTIFIED SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

ASKER