Lookup value from another workbook with multiple criteria (vba)

ybr_15

Board Regular
Joined
May 24, 2016
Messages
204
Office Version
  1. 2019
  2. 2013
Platform
  1. Windows
Hi everyone, my head is already dizzy looking for a solution. I have 2 workbooks (Salary and Result). Next, I want to get employee salaries and bonuses in the Result workbook (sheet: Data) based on the data in the Salary Workbook (sheet: List). I use 2 criteria from: 'Employee ID' and 'Employee Name' to get the desired data. Can I help do it with vba? Thank You
salary.xlsx
ABCDEF
1Employee List
2
3Employee IDEmployee NameGenderDepartmentSalaryBonus
4A21.2009Williams MaryMaleSCM$ 35,000$ 1,272
5A36.2020Brown RobertMaleHR-GA$ 32,000$ 1,746
6A75.2012Wilson ElizabethFemaleSCM$ 12,000$ 1,453
7A47.2003Moore JenniferFemaleMAINTENANCE$ 41,000$ 1,760
8A66.2007Brown CharlesMaleWAREHOUSE$ 39,000$ 1,753
9A44.2015Price LisaFemaleSCM$ 14,000$ 667
10A32.2006Wood DanielMaleFINANCE$ 13,750$ 1,413
11A26.2016Coleman DonaldMaleWAREHOUSE$ 37,500$ 610
12A62.2008Perry GeorgeFemaleTAX$ 12,050$ 1,269
13A46.2018Steele DonnaFemaleTAX$ 36,750$ 1,846
14A85.2007Schultz CarolMaleSCM$ 38,050$ 817
15A40.2021Munoz RuthMaleWAREHOUSE$ 11,000$ 944
16A42.2020Chandler JasonMaleHR-GA$ 29,000$ 1,320
17A86.2007Small MatthewMaleQC$ 45,500$ 1,846
18A35.2016Hensley JessicaFemaleWAREHOUSE$ 52,000$ 1,061
19A91.2021Brown GaryMaleHR-GA$ 8,000$ 543
20A78.2010Grimes JoseMaleHR-GA$ 17,000$ 1,804
21A53.2010Baxter BrendaFemaleSCM$ 36,000$ 1,141
22A39.2018Morin FrankMaleTAX$ 36,500$ 1,471
23A13.2000Tillman KathleenFemalePRODUCTION$ 9,750$ 1,776
24A92.2015Huber JoshuaMaleQC$ 31,750$ 1,633
25A94.2013Boyle DebraFemalePRODUCTION$ 38,050$ 1,560
26A95.2005Buckner JerryMaleHR-GA$ 37,500$ 711
27A76.2015Knowles AaronMalePRODUCTION$ 10,050$ 1,193
28A57.2002Velazquez CarlosMaleQC$ 9,075$ 1,848
29A68.2009Vang MarilynFemalePRODUCTION$ 29,750$ 865
List

Result.xlsx
ABCD
1Lookup Data
2
3Employee IDEmployee NameSalaryBonus
4A75.2012Wilson Elizabeth
5A26.2016Coleman Donald
6A86.2007Small Matthew
7A68.2009Vang Marilyn
8A76.2015Knowles Aaron
9A13.2000Tillman Kathleen
Data
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college
Make sure that both workbooks are open. Place this macro in the Salary workbook and run it from there.
VBA Code:
Sub MatchData()
    Application.ScreenUpdating = False
    Dim srcWB As Workbook, desWB As Workbook
    Dim desWS As Worksheet, srcWS As Worksheet, arr1 As Variant, arr2 As Variant, Val As String, dic As Object
    Set srcWB = ThisWorkbook.Sheets("List")
    Set desWB = Workbooks("Result.xlsx").Sheets("Data")
    Set srcWS = srcWB.Sheets("List")
    Set desWS = desWB.Sheets("Data")
    arr1 = desWS.Range("A4", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
    arr2 = srcWS.Range("A4", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 6).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr1, 1)
        Val = arr1(i, 1) & "|" & arr1(i, 2)
        If Not dic.Exists(Val) Then
            dic.Add Key:=Val, Item:=i + 3
        End If
    Next i
    For i = 1 To UBound(arr2, 1)
        Val = arr2(i, 1) & "|" & arr2(i, 2)
        If dic.Exists(Val) Then
            desWS.Range("C" & dic(Val)).Resize(, 2).Value = Array(arr2(i, 5), arr2(i, 6))
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Make sure that both workbooks are open. Place this macro in the Salary workbook and run it from there.
VBA Code:
Sub MatchData()
    Application.ScreenUpdating = False
    Dim srcWB As Workbook, desWB As Workbook
    Dim desWS As Worksheet, srcWS As Worksheet, arr1 As Variant, arr2 As Variant, Val As String, dic As Object
    Set srcWB = ThisWorkbook.Sheets("List")
    Set desWB = Workbooks("Result.xlsx").Sheets("Data")
    Set srcWS = srcWB.Sheets("List")
    Set desWS = desWB.Sheets("Data")
    arr1 = desWS.Range("A4", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
    arr2 = srcWS.Range("A4", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 6).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr1, 1)
        Val = arr1(i, 1) & "|" & arr1(i, 2)
        If Not dic.Exists(Val) Then
            dic.Add Key:=Val, Item:=i + 3
        End If
    Next i
    For i = 1 To UBound(arr2, 1)
        Val = arr2(i, 1) & "|" & arr2(i, 2)
        If dic.Exists(Val) Then
            desWS.Range("C" & dic(Val)).Resize(, 2).Value = Array(arr2(i, 5), arr2(i, 6))
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
Hi, mumps
Thanks for your answer, I made a few changes because there is still an error from your code. Your code works properly.... By the way, can you explain to me how this code works? I'm really still not familiar with Ubound. Thank You
VBA Code:
Sub MatchData()
    Application.ScreenUpdating = False
    Dim srcWB As Workbook, desWB As Workbook
    Dim desWS As Worksheet, srcWS As Worksheet, arr1 As Variant, arr2 As Variant, Val As String, dic As Object
    Dim i As Integer
    Set srcWB = ThisWorkbook
    Set desWB = Workbooks("Result.xlsx")
    Set srcWS = srcWB.Sheets("List")
    Set desWS = desWB.Sheets("Data")
    arr1 = desWS.Range("A4", desWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 2).Value
    arr2 = srcWS.Range("A4", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 6).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr1, 1)
        Val = arr1(i, 1) & "|" & arr1(i, 2)
        If Not dic.Exists(Val) Then
            dic.Add Key:=Val, Item:=i + 3
        End If
    Next i
    For i = 1 To UBound(arr2, 1)
        Val = arr2(i, 1) & "|" & arr2(i, 2)
        If dic.Exists(Val) Then
            desWS.Range("C" & dic(Val)).Resize(, 2).Value = Array(arr2(i, 5), arr2(i, 6))
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Regarding the previous question, we are still using the same criteria ('Employee ID' and 'Employee Name') but if the criteria are not contiguous then how to modify the code? Here is an example. Thank You
Result - Mode 2.xlsm
BCDEF
1Lookup Data
2
3Employee IDYear of EntryEmployee NameSalaryBonus
4A75.20122012Wilson Elizabeth
5A26.20162016Coleman Donald
6A86.20072007Small Matthew
7A68.20092009Vang Marilyn
8A76.20152015Knowles Aaron
9A13.20002000Tillman Kathleen
Data
 
Upvote 0
Try:
Rich (BB code):
Sub MatchData()
    Application.ScreenUpdating = False
    Dim srcWB As Workbook, desWB As Workbook
    Dim desWS As Worksheet, srcWS As Worksheet, arr1 As Variant, arr2 As Variant, Val As String, dic As Object, i As Integer
    Set srcWB = ThisWorkbook
    Set desWB = Workbooks("Result.xlsx")
    Set srcWS = srcWB.Sheets("List")
    Set desWS = desWB.Sheets("Data")
    arr1 = desWS.Range("B4", desWS.Range("B" & Rows.Count).End(xlUp)).Resize(, 3).Value
    arr2 = srcWS.Range("A4", srcWS.Range("A" & Rows.Count).End(xlUp)).Resize(, 6).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr1, 1)
        Val = arr1(i, 1) & "|" & arr1(i, 3)
        If Not dic.Exists(Val) Then
            dic.Add Key:=Val, Item:=i + 3
        End If
    Next i
    For i = 1 To UBound(arr2, 1)
        Val = arr2(i, 1) & "|" & arr2(i, 2)
        If dic.Exists(Val) Then
            desWS.Range("E" & dic(Val)).Resize(, 2).Value = Array(arr2(i, 5), arr2(i, 6))
        End If
    Next i
    Application.ScreenUpdating = True
End Sub
In the lines of code in red, the two array variables arr1 and arr2 contain the values of the ranges in memory. This makes the code run much faster because the macro accesses the data in memory without having to go back to the sheet to access the data. The lines of code in blue simply loop through each row of each range where "UBound" represents the count of the rows in each range so based on the data you posted, UBound(aar1,1) would be equal to 26 and UBound(aar2,1) would be equal to 6. I would suggest that you do a little research using the terms "arrays in excel vba" and "scripting dictionary excel vba". These two links may be able to get you started:
 
Upvote 0
Solution

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top