I created an Excel AddIn that has a function called SLOOKUP
which can replace INDEX MATCH
combinations in an easy and smart way. For more info please visit my blog post. I would like you to optimize this further if possible.
Function SLOOKUP(database As Range, lookupCol As Range)
' Description: Excel UDF that implements INDEX+MATCH combination in a smart way
' by picking up [lookup_value] and [returnCol] relative to the [lookupCol]
' Author : Hussain Khamis
' Website : XpertInTech.com
' Version : 0.8
'
' Definitions:
'
' INPUT:
' database As Range : The database to perform the lookups against; must include the headers as well
' lookupCol As Range : The name of the column that should contains the [lookup_value]
'
' INTERNAL:
' o_Caller As Object : Stores Application.Caller to determine later the type of the caller of this function
' r_Caller As Range : Sets r_Caller to the range in o_Caller after checking that o_Caller type is a range
' lookup_value As Variant : The value, that would ideally be unique (like an ID), to retrieve the other columns based on
' returnCol As Variant : The name of the column that the returned value will come from
' i_lookupCol As Integer : The column number that will be looked up in the database and should contains the [lookup_value]
' i_returnCol As Integer : The column number that the final value will be retrieved from
' i_returnRow As Integer : The row number that intersects with i_returnCol which the final value will be retrieved from
'
On Error GoTo PROCErr
'Get lookup and returnCol relative to lookupCol
'Caller of this function must be one cell at a time or else the result will be an error
'Application.Volatile
Dim o_Caller As Object
Set o_Caller = Application.Caller
Select Case TypeName(o_Caller)
Case "Range"
Dim r_Caller As Range
Set r_Caller = o_Caller
If r_Caller.Count = 1 Then
Dim lookup_value As Variant
Dim returnCol As Variant
With lookupCol
lookup_value = .Offset(r_Caller.Row - .Row, 0)
returnCol = .Offset(0, r_Caller.Column - .Column)
End With
Else
GoTo PROCErr
End If
Case Else
GoTo PROCErr
End Select
'Get lookupCol #
Dim i_lookupCol As Integer
i_lookupCol = WorksheetFunction.Match(lookupCol.Value2, database.Rows(1), 0)
'Get returnCol #
Dim i_returnCol As Integer
i_returnCol = WorksheetFunction.Match(returnCol, database.Rows(1), 0)
'Get returnRow #
Dim i_returnRow As Integer
i_returnRow = WorksheetFunction.Match(lookup_value, database.Columns(i_lookupCol), 0)
'Result
SLOOKUP = WorksheetFunction.Index(database, i_returnRow, i_returnCol)
Exit Function
'On error
PROCErr:
SLOOKUP = CVErr(xlErrNA)
End Function