View Full Version : [SOLVED:] Vlookup in VBA: lookup multiple values
sharc316
04-01-2017, 06:02 PM
Hi,
I would like to lookup two values; in column A and B, if the two values are found, ex 0089 and 0170, then would like to return a value from column C. The values will be matched to a mapping table in another workbook. Thank you for your help.
A B C
LEG ORG
LEG DEST
TRIP
0089
0170
Trip 1
0170
8154
8154
0072
0072
0089
Option Explicit
Sub test()
Dim tbl
Dim dic As Object
Dim i As Long
tbl = Workbooks("Book1").Sheets(2).Cells(1).CurrentRegion.Columns("a:c").Value
Set dic = CreateObject("scripting.dictionary")
For i = 2 To UBound(tbl)
dic(tbl(i, 1) & vbTab & tbl(i, 2)) = tbl(i, 3)
Next
With Cells(1).CurrentRegion.Columns("a:c")
For i = 2 To .Rows.Count
.Cells(i, 3).Value = dic(.Cells(i, 1).Value & vbTab & .Cells(i, 2).Value)
Next
End With
End Sub
sharc316
04-01-2017, 07:10 PM
Thank you Mana. I'm getting an out of range error on this line: tbl = Workbooks("Master").Sheets(2).Cells(1).CurrentRegion.Columns("A:C").Value
Do you think a file path needs to be provided for the workbook and worksheet where the mapping table is located?
Option Explicit
Sub test2()
Dim myPath As String
Dim fn As String
Dim wb As Workbook
Dim IsOpen As Boolean
Dim tblf
Dim dic As Object
Dim i As Long
myPath = "c:\****\***\"
fn = "Master.xlsx"
On Error Resume Next
Set wb = Workbooks(fn)
On Error GoTo 0
If wb Is Nothing Then
Set wb = Workbooks.Open(myPath & fn)
IsOpen = True
End If
tbl = wb.Sheets(1).Cells(1).CurrentRegion.Columns("a:c").Value
If IsOpen Then wc.Close False
Set dic = CreateObject("scripting.dictionary")
For i = 2 To UBound(tbl)
dic(tbl(i, 1) & vbTab & tbl(i, 2)) = tbl(i, 3)
Next
With Cells(1).CurrentRegion.Columns("a:c")
For i = 2 To .Rows.Count
.Cells(i, 3).Value = dic(.Cells(i, 1).Value & vbTab & .Cells(i, 2).Value)
Next
End With
End Sub
sharc316
04-01-2017, 08:24 PM
It's giving me "object required" on this line: If IsOpen Then wc.Close False
I've attached two files that I'm using.
18822
18823
Option Explicit
Sub test3()
Dim myPath As String
Dim fn As String
Dim shn As String
Dim wb As Workbook
Dim IsOpen As Boolean
Dim tbl
Dim dic As Object
Dim i As Long
myPath = "c:\****\***\"
fn = "Master.xlsm"
shn = "Trip Mapping"
On Error Resume Next
Set wb = Workbooks(fn)
On Error GoTo 0
If wb Is Nothing Then
Set wb = Workbooks.Open(myPath & fn)
IsOpen = True
End If
tbl = wb.Sheets(shn).Cells(1).CurrentRegion.Value
If IsOpen Then wb.Close False
Set dic = CreateObject("scripting.dictionary")
For i = 2 To UBound(tbl)
dic(tbl(i, 1) & vbTab & tbl(i, 2)) = tbl(i, 3)
Next
With Cells(1).CurrentRegion.Columns("d:f")
For i = 2 To .Rows.Count
MsgBox .Cells(i, 1).Value
.Cells(i, 3).Value = dic(.Cells(i, 1).Value & vbTab & .Cells(i, 2).Value)
Next
End With
End Sub
mdmackillop
04-02-2017, 06:25 AM
I think I see what you want to do but can you clarify with reference to the posted workbooks the "source" data and which are the comparison/result columns?
sharc316
04-02-2017, 07:25 AM
This is working! Did a quick test and it looks to be working pretty well. I just commented out the the message box since I'll be running this on multiple workbooks.
Mana, thank you very much for your help. Really appreciate it!
sharc316
04-02-2017, 07:26 AM
mdmackillop, thank you for replying. Mana has actually provided a solution.
Aussiebear
04-02-2017, 03:19 PM
@ sharc316. If this thread is solved to your satisfaction, could you mark it as so by going to the Thread Tools dropdown and click on Mark thread as solved please?
sharc316
04-02-2017, 03:43 PM
Done
Keep it simple:
Sub M_snb()
With GetObject("G:\OF\master.xlsm")
sn = .Sheets("trip mapping").Cells(1).CurrentRegion
.Close 0
End With
sp = Workbooks("Rawdatatest.xls").Sheets("linehaul trips").Cells(1).CurrentRegion
With CreateObject("scripting.dictionary")
For j = 1 To UBound(sp)
x0 = .Item(sp(j, 4) & "_" & sp(j, 5))
Next
For j = 1 To UBound(sn)
If .exists(sn(j, 1) & "_" & sn(j, 2)) Then .Item(sn(j, 1) & "_" & sn(j, 2)) = sn(j, 3)
Next
Workbooks("Rawdatatest.xls").Sheets("linehaul trips").Cells(1, 6).Resize(.Count) = Application.Transpose(.items)
End With
End Sub
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.