Excel VBA- VLOOKUP with multiple criteria - excel

Question

I need a VBA code that searches for a specific Name (first dropdown), Products (second drop-down), then returns the unit price. I can use VLOOKUP to search names and return the unit price but I need to search for names and products and be able to pull the prices quickly. I used Evaluate function but the result is #VALUE!
Sub unitPrice()
Set sh4 = ThisWorkbook.Sheets("Invoice")
Set sh5 = ThisWorkbook.Sheets("Unit Price")
sh4.Range("H18") = _
sh4.Evaluate("MATCH(" & sh4.Cells(11, 1).Address(False, False) _
& "&" & sh4.Cells(18, 1).Address(False, False) _
& ",'Sh5!B2:B5&sh5!A2:A5,0)")
End Sub
Screenshot of Invoice and Unit Price sheet

Answer 1

I am assuming that you have two tables (insert > table): tblInvoice and tblUnitPrice. It is much easier to reference them in VBA via listobject than without. If you are not using tables you have to adjust the ranges accordingly.
What my code does: It inserts an INDEX/MATCH-Formula to retrieve the Unitprice for all rows in the table - and then writes the pure values back to the cells.
Public Sub updateUnitPricesInInvoice()
Dim loInvoice As ListObject
Set loInvoice = ThisWorkbook.Worksheets("Invoice").ListObjects("tblInvoice")
With loInvoice.ListColumns("UnitPrice").DataBodyRange
.Formula2 = "=INDEX(tblUnitPrices[UnitPrice],MATCH(1,(tblUnitPrices[Name]=[#Name])*(tblUnitPrices[Product]=[#Product])))"
.value = .value
End With
End Sub

Answer 2

Alternative solution minimising interaction with sheet by matching in memory:
Option Explicit
Sub SimpleMatch()
Dim sh5 As Worksheet, sh4 As Worksheet 'declare vars
Set sh4 = ThisWorkbook.Sheets("Invoice") 'set sheet
Set sh5 = ThisWorkbook.Sheets("Unit Price") 'set sheet
Dim arr, arr2, LastRowSh4 As Long, LastRowSh5 As Long
LastRowSh4 = sh4.Cells(sh4.Rows.Count, "A").End(xlUp).Row 'count rows from last row
LastRowSh5 = sh5.Cells(sh5.Rows.Count, "A").End(xlUp).Row 'count rows from last row
arr = sh4.Range(sh4.Cells(1, 1), sh4.Cells(LastRowSh4, 8)).Value2 'load invoices to mem
arr2 = sh5.Range(sh5.Cells(1, 1), sh5.Cells(LastRowSh5, 3)).Value2 'load prices to mem
Dim j As Long, dict As Object
Set dict = CreateObject("Scripting.Dictionary") 'create dictionary lateB
With dict 'used because I'm to lazy to retype dict everywhere :)
.CompareMode = 1 'textcompare
For j = 1 To UBound(arr2) 'add prices to dict
If Not .Exists(arr2(j, 1) & arr2(j, 2)) Then 'set key if I don't have it yet in dict
.Add Key:=arr2(j, 1) & arr2(j, 2), Item:=arr2(j, 3)
End If
Next j
Dim cust As String
For j = 1 To UBound(arr)
If arr(j, 1) = "Bill To:" Then
cust = arr(j + 1, 1) 'assumes you have only 1 customer in the sheet!
End If
If .Exists(arr(j, 1) & cust) Then 'retrieve produc & cust price
arr(j, 8) = dict(arr(j, 1) & cust) 'add to arr
End If
Next j
End With
With sh4
.Range(.Cells(1, 1), .Cells(UBound(arr), UBound(arr, 2))) = arr 'dump updated array to invoice sheet
End With
End Sub

Answer 3

This is the solution without tables/listobjects:
Assumption: you have added names for the following cells on invoice sheet
A11: customer
A17: labelDescription
H17: labelUnitPrice
H28: labelTotalAmount
In the first step we retrieve the range between the two labels "UnitPrice" and "TotalAmount" - that's where the formula goes.
Then the formula is written to that range - using again INDEX/MATCH.
In case there is not description nothing is displayed (there ISERROR)
And again: after calculation formulas are replaced by their values
Option Explicit
Public Sub updateUnitPricesInInvoice()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Invoice")
Dim rgUnitPrices As Range
Set rgUnitPrices = getRangeBetweenTwoLabels(ws, "labelUnitPrice", "labelTotalAmount")
With rgUnitPrices
'Excel 365
'.Formula2 = "=IFERROR(INDEX(UnitPrice!C:C,MATCH(1,(UnitPrice!A:A=Invoice!" & ws.Range("labelDescription").Offset(1).Address(False, True) & ")*(UnitPrice!B:B=customer),0)),"""")"
'other Excel versions
With rgUnitPrices
.Formula = "=IFERROR(INDEX(UnitPrice!C:C,MATCH(1,(UnitPrice!A:A=Invoice!$A" & rgUnitPrices.Rows(1).Row & ")*(UnitPrice!B:B=customer),0)),"""")"
.FormulaArray = .FormulaR1C1
End With
.Value = .Value
End With
End Sub
Private Function getRangeBetweenTwoLabels(ws As Worksheet, _
label1 As String, label2 As String)
Dim cStart As Range: Set cStart = ws.Range(label1).Offset(1)
Dim cEnd As Range: Set cEnd = ws.Range(label2).Offset(-1)
Set getRangeBetweenTwoLabels = ws.Range(cStart, cEnd)
End Function