[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1574
  • Last Modified:

Multiple Criteria VlookUp VBA


I have the following columns in Sheet1 A, B, C and I have same columns in Sheet2. Sheet2 is containing All year data and Sheet 1 is containing current months data.

I need a VBA which will be doing a multiple criteria based vlookup to pull up the value of Col C if SheetA!ColA = Sheet2!ColB And SheetA!ColB = Sheet2!ColA Then Pull the matching value from Sheet2!ColC To Sheet1!ColC

Please help.
2 Solutions
Chris BottomleyCommented:
You talk in terms of VBA so I presume you are processing row by row.  It is as suggested by Psychotec efficient to use sheet formulae.

Assuming you want to end up with data rather than formulae then we can apply ther formula via VBA and then switch the results to values.

Let us know the requirement with this in mind.

suvmitraAuthor Commented:
This is a part of an automation project. So yes I am alright with formula but then i need to apply this through VBA.
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Saurabh Singh TeotiaCommented:
Can you please post your sample file please.
suvmitraAuthor Commented:
As attached. Also as you can see I am trying to match Balnce O/S = Dispute which are containing currency values And most of the case these two column values does not match with each other for some fractional value. eg 28.04 = 28.03.
Therefore I want only to consider one decimal for matching more accurately.
eg. 28.0 = 28.0



Function MULTILOOKUP(ByRef Rng1 As Range, ByVal Crit1, _
                    ByRef Rng2 As Range, ByVal Crit2, ByRef Rng3 As Range) As Variant
Dim a As String, b As String, c As String, Fmla

a = Rng1.Address(, , , 1): a = Mid$(a, InStr(1, a, "]") + 1)
b = Rng2.Address(, , , 1): b = Mid$(b, InStr(1, b, "]") + 1)
c = Rng3.Address(, , , 1): c = Mid$(c, InStr(1, c, "]") + 1)

If Not IsNumeric(Crit1) Then Crit1 = """" & Crit1 & """"
If Not IsNumeric(Crit2) Then Crit2 = """" & Crit2 & """"
Fmla = "LOOKUP(2,1/((" & a & "=" & Crit1 & ")*(" & b & "=" & Crit2 & "))," & c & ")"

MULTILOOKUP = Evaluate(Fmla)

End Function
Sub kTest()
Dim ws1 As Worksheet, ws2 As Worksheet, Sht1ColA As Range, Sht1ColB As Range
Dim Sht2ColA As Range, Sht2ColB As Range, Sht2ColC As Range, Sht1ColC As Range
Dim i As Long, r As Long, c, a, b, x

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
With ws1
    r = .Range("a" & .Rows.Count).End(xlUp).Row
    Set Sht1ColA = .Range("a2:a" & r)
    Set Sht1ColB = .Range("b2:b" & r)
    Set Sht1ColC = .Range("c2:c" & r)
    a = Sht1ColA
    b = Sht1ColB
    c = Sht1ColC
End With
With ws2
    r = .Range("a" & .Rows.Count).End(xlUp).Row
    Set Sht2ColA = .Range("a2:a" & r)
    Set Sht2ColB = .Range("b2:b" & r)
    Set Sht2ColC = .Range("c2:c" & r)
End With

For i = 1 To UBound(a, 1)
    x = MULTILOOKUP(Sht2ColC, a(i, 1), Sht2ColA, b(i, 1), Sht2ColB)
    If Not IsError(x) Then c(i, 1) = x
Sht1ColC.Value = c
End Sub

Open in new window

Leo TorresSQL DeveloperCommented:
I am still not understanding how you want your final result to be can you repost your file with your expected in sheet3 ...
Leo TorresSQL DeveloperCommented:
I am assuming you meant this if not let me know
Leo TorresSQL DeveloperCommented:
FYI if you copy and past formula to another you must confirm this array formula

Confirmed with CTRL + SHIFT + ENTER

if you just copy and paste and hit enter it wont work
suvmitraAuthor Commented:
Thank you all I will get back to you soon.
Leo TorresSQL DeveloperCommented:
Sorry I just saw realized last thread about rounding to nearest tenth...

Same as before Confirmed with CTRL + SHIFT + ENTER

Added an xls copy incase your still on 2003
suvmitraAuthor Commented:

Featured Post

Vote for the Most Valuable Expert

It’s time to recognize experts that go above and beyond with helpful solutions and engagement on site. Choose from the top experts in the Hall of Fame or on the right rail of your favorite topic page. Look for the blue “Nominate” button on their profile to vote.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now