vba - add third condition to this 2 conditional look up formula

davidhasselhoff · Feb 18, 2009

Hi everyone!

I got this function I found on the internet and I use it to look up a value in a table based on two conditions, kind of a sumproduct for vba...

However, now I would require it to work with an additional condition...

So does somebody of you know how the following function works (because I don't

), and could he/she please tell me how I could add a third condition?

Code:

Public Function BLOOKUP(first_lookup_value As Variant, _
    first_col As Range, _
    second_lookup_value As Variant, _
    second_col As Range, _
    return_col As Range, _
    Optional NA_value As Variant = CVErr(xlErrNA)) As Variant
     
     'Like  Vlookup, but can take two input values
     
    Application.Volatile (False)
    Dim CriteriaOffset As Long
    Dim ReutrnOffset As Long
    Dim cell As Range
     
    If first_col.Parent Is second_col.Parent = False Then Exit Function
    If first_col.Parent Is return_col.Parent = False Then Exit Function
     
    BLOOKUP = NA_value
     
    Set first_col = Intersect(first_col, first_col.Parent.UsedRange)
    If first_col Is Nothing Then Exit Function
     
    Set second_col = Intersect(second_col, second_col.Parent.UsedRange)
    If second_col Is Nothing Then Exit Function
     
    CriteriaOffset = second_col.Column - first_col.Column
    ReutrnOffset = return_col.Column - first_col.Column
     
    For Each cell In Union(first_col.Cells(1), first_col.Columns(1))
        If UCase(cell) = UCase(first_lookup_value) Then
            If UCase(cell.Offset(0, CriteriaOffset)) = UCase(second_lookup_value) Then
                BLOOKUP = cell.Offset(0, ReutrnOffset)
                Exit For
            End If
        End If
    Next cell
     
End Function

Colin Legg · Feb 19, 2009

Hi

Why don't you just use an array formula?

Code:

=INDEX(Return_Range,MATCH(1,
    (Range1=Condition1)*
    (Range2=Condition2)*
    (Range3=Condition3),0))

If I was to use a VBA UDF to do 3 conditional lookup, I'd evaluate the array formula. The general gist would be:

Code:

Public Function BLOOKUP( _
    Condition1 As Variant, _
    Range1 As Range, _
    Condition2, _
    Range2 As Range, _
    Condition3 As Variant, _
    Range3 As Range, _
    Return_Range As Range) As Variant
 
    BLOOKUP = Return_Range.Parent.Evaluate( _
                "INDEX(" & Return_Range.Address(external:=True) & _
                ",MATCH(1,(" & Range1.Address(external:=True) & "=" & Condition1 & ")*" & _
                "(" & Range2.Address(external:=True) & "=" & Condition2 & ")*" & _
                "(" & Range3.Address(external:=True) & "=" & Condition3 & "),0))")
 
 
End Function

Things to note. You can't reference entire columns for Range1, Range2 or Range3, unless you are using XL 2007.

If the conditions are strings, you would need to use triple quotes, so an example of calling the UDF from the worksheet would be:

Code:

=blookup("""Colin_L""",A2:A5,12,B2:B5,"""Friday""",C2:C5,E2:E5)

But I don't see any advantage of using a UDF instead of the native functions?

Colin

davidhasselhoff · Feb 19, 2009

Hi!
Thank you for answering me.

I wanted to use this formula because I failed to implement sumproduct without getting an error message, but now that I used your formula, I still get a type mismatch error, just the same as with the sumproduct...

I made sure to test the formula with values that should produce a match for sure, but I get a #value error in a1 when using the following code:

Code:

With ActiveWorkbook.Sheets("TransportCostcatalogue")
Set searchware = .Range("b2", .Range("b2").End(xlDown))
Set searchclient = .Range("h2", .Range("h2").End(xlDown))
Set searchmeans = .Range("v2", .Range("v2").End(xlDown))
Set searchagent = .Range("n2", .Range("n2").End(xlDown))
End With
 
means = BBLOOKUP(UserFormout.ListBox1.Text, searchware, UserFormone.ListBox1.Text, searchclient, UserFormout.ListBox4.Text, searchagent, searchprice)
Cells(1, 1) = means

(i modified your formula to become bblookup so i don't need to change the places where i use the 2 conditional bblookup formula)

usually, i would use "select case means" following the definition of "means", and i think that might be the reason for the type mismatch error i get...? (as it produces a #value error)

Colin Legg · Feb 19, 2009

Hi,

Can you just give a small bit of sample data from the worksheet? What sorts of data do the seachware, searchclient and searchagent columns hold? As I mentioned before, if they contain text (rather than numbers) then you need to add extra speech marks.

Code:

Sub test()
    With ActiveWorkbook.Sheets("TransportCostcatalogue")
        Set searchware = .Range("b2", .Range("b2").End(xlDown))
        Set searchclient = .Range("h2", .Range("h2").End(xlDown))
        Set searchmeans = .Range("v2", .Range("v2").End(xlDown))
        Set searchagent = .Range("n2", .Range("n2").End(xlDown))
    End With
    
    
    means = BBLOOKUP( _
                    """ & UserFormout.ListBox1.Text & """, _
                    searchware, _
                    """ & UserFormone.ListBox1.Text & """, _
                    searchclient, _
                    """ & UserFormout.TextBox4.Text & """, _
                    searchagent, _
                    searchprice)
                    
    Debug.Print means
End Sub
 
 
Public Function BBLOOKUP( _
    Condition1 As Variant, _
    Range1 As Range, _
    Condition2 As Variant, _
    Range2 As Range, _
    Condition3 As Variant, _
    Range3 As Range, _
    Return_Range As Range) As Variant
    
    Dim sFormula As String
    
    Debug.Print Condition1
    Debug.Print Condition2
    Debug.Print Condition3
    
    
    sFormula = _
                "INDEX(" & Return_Range.Address(external:=True) & _
                ",MATCH(1,(" & Range1.Address(external:=True) & "=" & Condition1 & ")*" & _
                "(" & Range2.Address(external:=True) & "=" & Condition2 & ")*" & _
                "(" & Range3.Address(external:=True) & "=" & Condition3 & "),0))"
    
    Debug.Print sFormula
    
    BLOOKUP = Return_Range.Parent.Evaluate(sFormula)
    
 
 
End Function

I added some debug.print lines so you can what is being passed into the function. If it still produces an error value:
(i) what was printed into your immediate window?
(ii) is that condition combination definitely in the table?
(iii) try to get a formula working in the worksheet and then try to see what might be causing the UDF to produce a different result.

Hope that helps...

davidhasselhoff · Feb 19, 2009

Rich (BB code):

Sub test()
    With ActiveWorkbook.Sheets("TransportCostcatalogue")
        Set searchware = .Range("b2", .Range("b2").End(xlDown))
        Set searchclient = .Range("h2", .Range("h2").End(xlDown))
        Set searchmeans = .Range("v2", .Range("v2").End(xlDown))
        Set searchagent = .Range("n2", .Range("n2").End(xlDown))
    End With
    
    
    means = BBcLOOKUP( _
                    """ & UserFormout.ListBox1.Text & """, _
                    searchware, _
                    """ & UserFormone.ListBox1.Text & """, _
                    searchclient, _
                    """ & UserFormout.TextBox4.Text & """, _
                    searchagent, _
                    searchmeans)
                    
    Debug.Print means
End Sub
 
 
Public Function BBcLOOKUP( _
    Condition1 As Variant, _
    Range1 As Range, _
    Condition2 As Variant, _
    Range2 As Range, _
    Condition3 As Variant, _
    Range3 As Range, _
    Return_Range As Range) As Variant
    
    Dim sFormula As String
    
    Debug.Print Condition1
    Debug.Print Condition2
    Debug.Print Condition3
    
    
    sFormula = _
                "INDEX(" & Return_Range.Address(external:=True) & _
                ",MATCH(1,(" & Range1.Address(external:=True) & "=" & Condition1 & ")*" & _
                "(" & Range2.Address(external:=True) & "=" & Condition2 & ")*" & _
                "(" & Range3.Address(external:=True) & "=" & Condition3 & "),0))"
    
    Debug.Print sFormula
    
    BBcLOOKUP = Return_Range.Parent.Evaluate(sFormula)
    
 
 
End Function

I modified your code where i colored it red, at the first spot because that's the right lookup range, and at the second spot because i thought you overlooked that part. please correct me if i was wrong...

Well however it still doesn't work, the whole table where the input comes from is text, and i tried it with different combinations i looked up manually.

The error i get immediatly in a window is the following:

Compile error:
ByRef argument type mismatch

and by trying to get the formula working in the worksheet, do you mean i should put a sumproduct formula somewhere doing the same?

Colin Legg · Feb 19, 2009

Hi,

[COLOR=black said:
davidhasselhoff[/color]]and by trying to get the formula working in the worksheet, do you mean i should put a sumproduct formula somewhere doing the same?

It's not a sumproduct formula = there are no sumproduct() worksheet functions in there. Yes, I mean write the formula in the worksheet. The syntax I posted earlier is:

Rich (BB code):

=INDEX(Return_Range,MATCH(1,
    (Range1=Condition1)*
    (Range2=Condition2)*
    (Range3=Condition3),0))

The corrections you suggested-
searchmeans, I got that typo error because I copied your earlier code which used SearchPrice.

davidhasselhoff said:

Rich (BB code):

means = BBLOOKUP(UserFormout.ListBox1.Text, searchware, UserFormone.ListBox1.Text, searchclient, UserFormout.ListBox4.Text, searchagent, searchprice)

BBcLOOKUP - sure, do you want BBcLOOKUP or BBLOOKUP though!?

davidhasselhoff said:
i modified your formula to become bblookup so i don't need to change the places where i use the 2 conditional bblookup formula

The byref error - (I omitted the declarations because you omitted them in the code sample you posted). Declare searchware, searchclient etc... as Range Object variables. Here's a corrected version for you, still not tested on my side:

Rich (BB code):

Option Explicit
Sub test()
    Dim searchware As Range
    Dim searchclient As Range
    Dim searchmeans As Range
    Dim searchagent As Range
    Dim means As Variant
 
 
    With ActiveWorkbook.Sheets("TransportCostcatalogue")
        Set searchware = .Range("b2", .Range("b2").End(xlDown))
        Set searchclient = .Range("h2", .Range("h2").End(xlDown))
        Set searchmeans = .Range("v2", .Range("v2").End(xlDown))
        Set searchagent = .Range("n2", .Range("n2").End(xlDown))
    End With
 
 
    means = BBcLOOKUP( _
                    """ & UserFormout.ListBox1.Text & """, _
                    searchware, _
                    """ & UserFormone.ListBox1.Text & """, _
                    searchclient, _
                    """ & UserFormout.TextBox4.Text & """, _
                    searchagent, _
                    searchmeans)
 
    Debug.Print means
End Sub
Public Function BBcLOOKUP( _
    Condition1 As Variant, _
    Range1 As Range, _
    Condition2 As Variant, _
    Range2 As Range, _
    Condition3 As Variant, _
    Range3 As Range, _
    Return_Range As Range) As Variant
 
    Dim sFormula As String
 
    Debug.Print Condition1
    Debug.Print Condition2
    Debug.Print Condition3
 
 
    sFormula = _
                "INDEX(" & Return_Range.Address(external:=True) & _
                ",MATCH(1,(" & Range1.Address(external:=True) & "=" & Condition1 & ")*" & _
                "(" & Range2.Address(external:=True) & "=" & Condition2 & ")*" & _
                "(" & Range3.Address(external:=True) & "=" & Condition3 & "),0))"
 
    Debug.Print sFormula
 
    BBcLOOKUP = Return_Range.Parent.Evaluate(sFormula)
 
 
 
End Function

Hope that helps!

davidhasselhoff · Feb 23, 2009

Hi! Thank you very much for trying to help me, but I think my excel is broken

If I use your code with a combination I looked up manually, it still returns a #value error...? how could this be possible?

davidhasselhoff · Feb 23, 2009

i tried the following code in order to achieve the same goal, but as I said, my excel is broken

Code:

 Sub test()
    Dim searchware As Range
    Dim searchclient As Range
    Dim searchmeans As Range
    Dim searchagent As Range
    Dim means As Variant
    Dim rOne As Range
    Dim sOne As String, sTwo As String, sThree As String
   
 UserFormone.Show
 UserFormout.Show
 
 
    With ActiveWorkbook.Sheets("TransportCostcatalogue")
        Set rOne = Columns("B:B").Find(sOne)
    End With
 
 
 sOne = UserFormout.ListBox1.Text
    sTwo = UserFormone.ListBox1.Text
    sThree = UserFormout.ListBox4.Text
     
    
    
    
    If Not rOne Is Nothing Then
        If rOne.Offset(0, 6) = sTwo Then
            If rOne.Offset(0, 12) = sThree Then
                 MsgBox rOne.Offset(0, 20) & " and " & rOne.Offset(0, 27)
                Exit Sub
            End If
        End If
    End If
    MsgBox "0"
 
End Sub

Now I suppose these problems persist due to my formatting...? So does anybody know how I have to format my lookup table?
I think I'll be needing a macro to do so, as the table is rather big...

davidhasselhoff · Feb 23, 2009

I managed to do it as follows:

Code:

    sOne = UserFormout.ListBox1.Text
    sTwo = UserFormone.ListBox1.Text
    sThree = UserFormout.ListBox4.Text
     
   
    With ActiveWorkbook.Sheets("TransportCostcatalogue")
        Set SearchRange = .Range("b2", .Range("b2").End(xlDown))
    End With
    FindWhat = sOne
    LookIn = xlValues
    LookAt = xlPart
    SearchOrder = xlByRows
    MatchCase = False
    
    '''''''''''''''''''
    ' Search the range.
    '''''''''''''''''''
    Set FoundCells = FindAll(SearchRange:=SearchRange, FindWhat:=FindWhat, _
        LookIn:=LookIn, LookAt:=LookAt, SearchOrder:=SearchOrder, MatchCase:=MatchCase)
    
     ''''''''''''''''''''''
    ' Display the results.
    ''''''''''''''''''''''
    If FoundCells Is Nothing Then
        MsgBox "Nothing found"
    Else
   ' End If
    For Each FoundCell In FoundCells.Cells
         
         If Not FoundCells Is Nothing Then
        If FoundCell.Offset(0, 6) = sTwo Then
            If FoundCell.Offset(0, 12) = sThree Then
                 meansout = FoundCell.Offset(0, 20)
                 Price = FoundCell.Offset(0, 27)
                
            End If
        End If
    End If
  Next FoundCell
  End If

but well it isn't very elegant...

vba - add third condition to this 2 conditional look up formula

davidhasselhoff

New Member

Excel Facts

Colin Legg

MrExcel MVP

davidhasselhoff

New Member

Colin Legg

MrExcel MVP

davidhasselhoff

New Member

Colin Legg

MrExcel MVP

davidhasselhoff

New Member

davidhasselhoff

New Member

davidhasselhoff

New Member

Similar threads

Forum statistics

Share this page

vba - add third condition to this 2 conditional look up formula

New Member

Excel Facts

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

New Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock