Function MLOOKUP(ByRef TableArray As Range, ByVal LookupVal, ByRef 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 & "," & LookupVal & ")")
fFoundNo = Evaluate("match(" & CLng(LookupVal) & "," & LookupRange.Address & ",0)")
ElseIf IsDate(LookupVal) Then
LV_Cnt = Evaluate("countif(" & LookupRange.Address & "," & CLng(LookupVal) & ")")
fFoundNo = Evaluate("match(" & CLng(LookupVal) & "," & LookupRange.Address & ",0)")
Else
strLval = """" & LookupVal & """"
LV_Cnt = Evaluate("countif(" & LookupRange.Address & "," & strLval & ")")
fFoundNo = Evaluate("match(" & strLval & "," & LookupRange.Address & ",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