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