Excel VBA- VLOOKUP with multiple criteria

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

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
    Dim c As Range
    For Each c In rgUnitPrices.Cells
        c.FormulaArray = "=IFERROR(INDEX(UnitPrice!C:C,MATCH(1,(UnitPrice!A:A=Invoice!$A" & c.Row & ")*(UnitPrice!B:B=customer),0)),"""")"
    Next

    .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

Answer 3

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