Could't find a solution? Ask the experts in our
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 daanalytics.com 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
.csharpcode, .csharpcode pre
{
font-size: small;
color: black;
font-family: consolas, "Courier New", courier, monospace;
background-color: #ffffff;
/*white-space: pre;*/
}
.csharpcode pre { margin: 0em; }
.csharpcode .rem { color: #008000; }
.csharpcode .kwrd { color: #0000ff; }
.csharpcode .str { color: #006080; }
.csharpcode .op { color: #0000c0; }
.csharpcode .preproc { color: #cc6633; }
.csharpcode .asp { background-color: #ffff00; }
.csharpcode .html { color: #800000; }
.csharpcode .attr { color: #ff0000; }
.csharpcode .alt
{
background-color: #f4f4f4;
width: 100%;
margin: 0em;
}
.csharpcode .lnum { color: #606060; }
- Login or register to post comments
- Feed: msdn feeds
- Original article
- 79 reads

