Back
Excel

Daniel’s Extreme Lookup Collection

Today’s author is Daniel Wiesenfeld, an Excel and Access Power User who is sharing his Extreme Lookup Collection with us so we can use the Excel User Defined Functions (UDFs) he created to enhance the lookup functionality. His web site danalytics.biz is currently under construction and should be available soon.

In the Visual Basic Editor, insert a Module and paste the following code:

' XVLOOKUP (& XHLOOKUP)
' Works just like a vlookup (and hlookup) except that the user refers to a lookup colum (or row)
' rather than a range,
it is 0 based and the user can "look left" (or "look upward") by using a negative
' column (or row) index.
' There is also an optional argument to allow the user to offset the cell to be returned by any number
' of rows (or columns)
' I do not give users the option to choose between exact or approximate match - it is always exact Function XVLOOKUP(Lookup_Column As Range, Lookup_Value As Variant, Column_Index As Integer, _ Optional Row_Offset As Integer) Dim DCol, DRow As Integer Dim DSheet, strCRange, strARange As String Dim ARange As Range DCol = Lookup_Column.Column DCol = DCol + Column_Index If IsMissing(Row_Offset) Then Row_Offset = 0 End If DSheet = Lookup_Column.Parent.Name strCRange = Lookup_Column.Address DRow = WorksheetFunction.Match(Lookup_Value, Worksheets(DSheet).Range(strCRange), 0) DRow = DRow + (Lookup_Column.Row - 1) + Row_Offset Set ARange = Range(Cells(DRow, DCol), Cells(DRow, DCol)) strARange = ARange.Address XVLOOKUP = Worksheets(DSheet).Range(strARange).Value End Function Public Function XHLOOKUP(Lookup_Row As Range, Lookup_Value As Variant, Row_Index As Integer, _ Optional Column_Offset As Integer) Dim DCol, DRow As Integer Dim DSheet, strRRange, strARange As String Dim ARange As Range DRow = Lookup_Row.Row DRow = DRow + Row_Index If IsMissing(Column_Offset) Then Column_Offset = 0 End If DSheet = Lookup_Row.Parent.Name strRRange = Lookup_Row.Address DCol = WorksheetFunction.Match(Lookup_Value, Worksheets(DSheet).Range(strRRange), 0) DCol = DCol + (Lookup_Row.Column - 1) + Column_Offset Set ARange = Range(Cells(DRow, DCol), Cells(DRow, DCol)) strARange = ARange.Address XHLOOKUP = Worksheets(DSheet).Range(strARange).Value End Function 'XVHLOOKUP 'looks up value in a range based on column and row headers Public Function XVHLOOKUP(Lookup_Range As Range, Row_Header As Variant, Column_Header As Variant) Dim DCol, DRow, TRow, BRow, LCol, RCol As Integer Dim DSheet, strCRange, strRRange, strARange As String Dim CRange, RRange, ARange As Range DSheet = Lookup_Range.Parent.Name TRow = Lookup_Range.Row BRow = TRow + Lookup_Range.Rows.Count - 1 LCol = Lookup_Range.Column RCol = LCol + Lookup_Range.Columns.Count - 1 Set CRange = Range(Cells(TRow, LCol), Cells(BRow, LCol)) strCRange = CRange.Address DRow = WorksheetFunction.Match(Row_Header, Worksheets(DSheet).Range(strCRange), 0) DRow = DRow + Lookup_Range.Row - 1 Set RRange = Range(Cells(TRow, LCol), Cells(TRow, RCol)) strRRange = RRange.Address DCol = WorksheetFunction.Match(Column_Header, Worksheets(DSheet).Range(strRRange), 0) DCol = DCol + Lookup_Range.Column - 1 Set ARange = Range(Cells(DRow, DCol), Cells(DRow, DCol)) strARange = ARange.Address XVHLOOKUP = Worksheets(DSheet).Range(strARange).Value End Function 'XLOOKUP 'Looks up value in a range and returns value of cell that is a specified number of rows and columns
'away from lookup cells
Public Function XLOOKUP(Lookup_Range As Range, Lookup_Value As Variant, _ Row_Offset As Integer, Column_Offset As Integer) Dim DRow, DCol As Integer Dim DSheet, DAddress, strARange As String Dim ARange As Range DRow = Lookup_Range.Find(Lookup_Value).Row DCol = Lookup_Range.Find(Lookup_Value).Column DRow = DRow + Row_Offset DCol = DCol + Column_Offset DSheet = Lookup_Range.Parent.Name Set ARange = Range(Cells(DRow, DCol), Cells(DRow, DCol)) strARange = ARange.Address XLOOKUP = Worksheets(DSheet).Range(strARange) End Function