Printable View
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
Code: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
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?
Code: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
It's giving me "object required" on this line: If IsOpen Then wc.Close False
I've attached two files that I'm using.
Attachment 18822
Attachment 18823
Code: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
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?
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!
mdmackillop, thank you for replying. Mana has actually provided a solution.
@ 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?
Done
Keep it simple:
Code: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