Consulting

Results 1 to 12 of 12

Thread: Vlookup in VBA: lookup multiple values

  1. #1
    VBAX Regular
    Joined
    Mar 2017
    Posts
    55
    Location

    Vlookup in VBA: lookup multiple values

    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

  2. #2
    VBAX Expert
    Joined
    Sep 2016
    Posts
    788
    Location
    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

  3. #3
    VBAX Regular
    Joined
    Mar 2017
    Posts
    55
    Location
    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?

  4. #4
    VBAX Expert
    Joined
    Sep 2016
    Posts
    788
    Location
    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

  5. #5
    VBAX Regular
    Joined
    Mar 2017
    Posts
    55
    Location

    Testing files

    It's giving me "object required" on this line: If IsOpen Then wc.Close False

    I've attached two files that I'm using.

    Master.xlsm

    RawDataTest.xls

  6. #6
    VBAX Expert
    Joined
    Sep 2016
    Posts
    788
    Location
    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

  7. #7
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    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?
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  8. #8
    VBAX Regular
    Joined
    Mar 2017
    Posts
    55
    Location
    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!

  9. #9
    VBAX Regular
    Joined
    Mar 2017
    Posts
    55
    Location
    mdmackillop, thank you for replying. Mana has actually provided a solution.

  10. #10
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    4,999
    Location
    @ 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?
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  11. #11
    VBAX Regular
    Joined
    Mar 2017
    Posts
    55
    Location
    Done

  12. #12
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •