Vlookup to Return Multiple Values

**Admin** · 04-02-2011, 06:11 PM

Hi All,

Here is a custom function to return multiple values for a lookup value.

Enjoy this custom LOOKUP function (MLOOKUP) !!

**Rajan_Verma** · 11-08-2012, 06:00 PM

Amended

Code:

Function MLOOKUP(TableArray As Range, ByVal LookupVal, LookupRange As Range, _
                                                        Optional ByVal NthMatch As Long)

' Author        : Krishnakumar @ ExcelFox.com



If Not TypeOf TableArray Is Range Then
    MLOOKUP = CVErr(2042)
    Exit Function
End If
If Not TypeOf LookupRange Is Range Then
    MLOOKUP = CVErr(2042)
    Exit Function
End If
If TableArray.Rows.Count <> LookupRange.Rows.Count Then
    MLOOKUP = CVErr(2042)
    Exit Function
End If
If TableArray.Columns.Count <> LookupRange.Columns.Count Then
    MLOOKUP = CVErr(2042)
    Exit Function
End If

Dim LV_Cnt      As Long 'Count Loookup Value
Dim KA1, KA2
Dim r As Long, c As Long
Dim fFoundNo    As Long
Dim n           As Long
Dim strLval     As String

If IsNumeric(LookupVal) Then
    LV_Cnt = Evaluate("countif(" & LookupRange.Address(, , , 1) & "," & LookupVal & ")")
    fFoundNo = Evaluate("match(" & CLng(LookupVal) & "," & LookupRange.Address(, , , 1) & ",0)")
ElseIf IsDate(LookupVal) Then
    LV_Cnt = Evaluate("countif(" & LookupRange.Address(, , , 1) & "," & CLng(LookupVal) & ")")
    fFoundNo = Evaluate("match(" & CLng(LookupVal) & "," & LookupRange.Address(, , , 1) & ",0)")
Else
    strLval = """" & LookupVal & """"
    LV_Cnt = Evaluate("countif(" & LookupRange.Address(, , , 1) & "," & strLval & ")")
    fFoundNo = Evaluate("match(" & strLval & "," & LookupRange.Address(, , , 1) & ",0)")
End If

If NthMatch > 0 Then
    If LV_Cnt = 0 Or NthMatch > LV_Cnt Then
        MLOOKUP = CVErr(2042)
        Exit Function
    End If
End If


KA1 = TableArray: KA2 = LookupRange

For r = fFoundNo To UBound(KA1, 1)
    For c = 1 To UBound(KA1, 2)
        If LCase$(KA2(r, c)) = LCase$(LookupVal) Then
            If NthMatch Then
                n = n + 1
                If n = NthMatch Then
                    MLOOKUP = KA1(r, c)
                    Exit Function
                End If
            Else
                MLOOKUP = MLOOKUP & "," & KA1(r, c)
            End If
        End If
    Next
Next
MLOOKUP = Mid$(MLOOKUP, 2)
End Function

**Admin** · 12-20-2012, 10:16 PM

Here is a latest version. Code amended to ignore blanks in the result.

Code:

Public Function MLOOKUP(TableArray As Range, ByVal LookupVal, LookupRange As Range, _
                                    Optional ByVal NumAsText As Boolean = False, _
                                    Optional ByVal NthMatch As Long, _
                                    Optional IgnoreBlanks As Boolean = True)
'---------------------------------------------------------------------------------------
' Procedure : MLOOKUP
' Author    : Krishnakumar @ ExcelFox.com
' Date      : 12/5/2012
' Purpose   : Returns multiple values
' Amended   : Include option to ignore blanks - 07/22/13
'---------------------------------------------------------------------------------------
If Not TypeOf TableArray Is Range Then
    MLOOKUP = CVErr(2042)
    Exit Function
End If
If Not TypeOf LookupRange Is Range Then
    MLOOKUP = CVErr(2042)
    Exit Function
End If
If TableArray.Rows.Count <> LookupRange.Rows.Count Then
    MLOOKUP = CVErr(2042)
    Exit Function
End If
If TableArray.Columns.Count <> LookupRange.Columns.Count Then
    MLOOKUP = CVErr(2042)
    Exit Function
End If

Dim LV_Cnt      As Long 'Count Loookup Value
Dim KA1, KA2
Dim r As Long, c As Long
Dim fFoundNo    As Long
Dim n           As Long
Dim strLval     As String

If IsNumeric(LookupVal) Then
    LV_Cnt = Evaluate("countif(" & LookupRange.Address(, , , 1) & "," & LookupVal & ")")
    If NumAsText Then GoTo 1
    fFoundNo = Evaluate("match(" & CLng(LookupVal) & "," & LookupRange.Address(, , , 1) & ",0)")
ElseIf IsDate(LookupVal) Then
    LV_Cnt = Evaluate("countif(" & LookupRange.Address(, , , 1) & "," & CLng(LookupVal) & ")")
    fFoundNo = Evaluate("match(" & CLng(LookupVal) & "," & LookupRange.Address(, , , 1) & ",0)")
Else
1:
    strLval = """" & LookupVal & """"
    LV_Cnt = Evaluate("countif(" & LookupRange.Address(, , , 1) & "," & strLval & ")")
    fFoundNo = Evaluate("match(" & strLval & "," & LookupRange.Address(, , , 1) & ",0)")
End If

If NthMatch > 0 Then
    If LV_Cnt = 0 Or NthMatch > LV_Cnt Then
        MLOOKUP = CVErr(2042)
        Exit Function
    End If
End If


KA1 = TableArray: KA2 = LookupRange

For r = fFoundNo To UBound(KA1, 1)
    For c = 1 To UBound(KA1, 2)
        If LCase$(KA2(r, c)) = LCase$(LookupVal) Then
            If NthMatch Then
                n = n + 1
                If n = NthMatch Then
                    MLOOKUP = KA1(r, c)
                    Exit Function
                End If
            Else
                If Not IgnoreBlanks Then
                    MLOOKUP = MLOOKUP & "," & KA1(r, c)
                ElseIf Len(KA1(r, c)) Then
                    MLOOKUP = MLOOKUP & "," & KA1(r, c)
                End If
            End If
        End If
    Next
Next
MLOOKUP = Mid$(MLOOKUP, 2)
End Function

This handles numbers which are not true number ,but text. Just pass the 3rd parameter as TRUE. By default it is FALSE.

http://www.excelfox.com/forum/f2/mlo...-710/#post3172

**radionut** · 07-22-2013, 01:27 AM

1) Hi

I have the data in the following format:
criteria.jpg

Which results in a bunch of commas. (Ignore the #value errors)
values.png

How can it be dealt with?

2) The algorithm seems to be quite time consuming even on a data range which is not that big. How does it work on big databases?

Thanks

**phaniy.405** · 08-27-2014, 04:02 PM

Originally Posted by Admin

Here is a latest version. Code amended to ignore blanks in the result.

Code:

Public Function MLOOKUP(TableArray As Range, ByVal LookupVal, LookupRange As Range, _
                                    Optional ByVal NumAsText As Boolean = False, _
                                    Optional ByVal NthMatch As Long, _
                                    Optional IgnoreBlanks As Boolean = True)
'---------------------------------------------------------------------------------------
' Procedure : MLOOKUP
' Author    : Krishnakumar @ ExcelFox.com
' Date      : 12/5/2012
' Purpose   : Returns multiple values
' Amended   : Include option to ignore blanks - 07/22/13
'---------------------------------------------------------------------------------------
If Not TypeOf TableArray Is Range Then
    MLOOKUP = CVErr(2042)
    Exit Function
End If
If Not TypeOf LookupRange Is Range Then
    MLOOKUP = CVErr(2042)
    Exit Function
End If
If TableArray.Rows.Count <> LookupRange.Rows.Count Then
    MLOOKUP = CVErr(2042)
    Exit Function
End If
If TableArray.Columns.Count <> LookupRange.Columns.Count Then
    MLOOKUP = CVErr(2042)
    Exit Function
End If

Dim LV_Cnt      As Long 'Count Loookup Value
Dim KA1, KA2
Dim r As Long, c As Long
Dim fFoundNo    As Long
Dim n           As Long
Dim strLval     As String

If IsNumeric(LookupVal) Then
    LV_Cnt = Evaluate("countif(" & LookupRange.Address(, , , 1) & "," & LookupVal & ")")
    If NumAsText Then GoTo 1
    fFoundNo = Evaluate("match(" & CLng(LookupVal) & "," & LookupRange.Address(, , , 1) & ",0)")
ElseIf IsDate(LookupVal) Then
    LV_Cnt = Evaluate("countif(" & LookupRange.Address(, , , 1) & "," & CLng(LookupVal) & ")")
    fFoundNo = Evaluate("match(" & CLng(LookupVal) & "," & LookupRange.Address(, , , 1) & ",0)")
Else
1:
    strLval = """" & LookupVal & """"
    LV_Cnt = Evaluate("countif(" & LookupRange.Address(, , , 1) & "," & strLval & ")")
    fFoundNo = Evaluate("match(" & strLval & "," & LookupRange.Address(, , , 1) & ",0)")
End If

If NthMatch > 0 Then
    If LV_Cnt = 0 Or NthMatch > LV_Cnt Then
        MLOOKUP = CVErr(2042)
        Exit Function
    End If
End If


KA1 = TableArray: KA2 = LookupRange

For r = fFoundNo To UBound(KA1, 1)
    For c = 1 To UBound(KA1, 2)
        If LCase$(KA2(r, c)) = LCase$(LookupVal) Then
            If NthMatch Then
                n = n + 1
                If n = NthMatch Then
                    MLOOKUP = KA1(r, c)
                    Exit Function
                End If
            Else
                If Not IgnoreBlanks Then
                    MLOOKUP = MLOOKUP & "," & KA1(r, c)
                ElseIf Len(KA1(r, c)) Then
                    MLOOKUP = MLOOKUP & "," & KA1(r, c)
                End If
            End If
        End If
    Next
Next
MLOOKUP = Mid$(MLOOKUP, 2)
End Function

This handles numbers which are not true number ,but text. Just pass the 3rd parameter as TRUE. By default it is FALSE.

http://www.excelfox.com/forum/f2/mlo...-710/#post3172

how to run this code ?

**KingTamo** · 10-25-2014, 10:24 PM

What about value repetition?

**zanjabil** · 12-12-2014, 08:44 PM

**Admin** · 03-08-2015, 11:59 AM

for a large data sets using UDF is not a good way.

ROWS($F$2:F2) is not comparing previous cell, rather it gives you a number.

**PetRose** · 02-17-2017, 04:41 PM

Originally Posted by Rajan_Verma

Amended
Latest version

Hi there, and thanks for provider enhanced versions to us

.
As a newbie here, but not to VBA nor Excel, I would like to ask a few simple basic Q to the UDP function:

Can you examplify the Call parameters, either by more extensive wording or by a true example ?
Why is the parameter sequence different from VLookup ? Its not obvious to me, why there are two table Ranges as params

I have managed to get it work with Text-lookup, but when I try with numbers (or number-like numbers), I get: #VALUE error. (Excel 2010)
Debugging it, it gets to the second Evaluate, after the Label 1 :
where variable 'fFoundNo' gets 'OutOfContext' value after Evaluate

So it may be my parameters, but I do not know yet...

Thanks in advance

**PetRose** · 02-17-2017, 07:03 PM

Here is a latest version. Code amended to ignore blanks in the result.

Hi there,
Can you elaborate on this otherwise useful UDF function here ?

Why is there two ranges as Inputs, and why is the sequence different from VLookup ?
Can you give some commentary notes, or examples that would give some expected results ?

Thanks to a newbie in here