What version of excel are you using?
If you're using xl2002 or higher, then you can try this.
The code includes .find() and that can't be used in xl2k and below in UDF's
called from worksheet cells.
Option Explicit
Public Function VLookupIfs(TableRng As Range, _
WhichCol As Long, _
WhichMatch As Long, _
ParamArray myParms() As Variant) As Variant
Dim iCtr As Long
Dim HowManyParms As Long
Dim HowManyColsInTable As Long
Dim OkToContinue As Boolean
Dim HowManyMatches As Long
Dim myFormula As String
Dim QtMark As String
Dim FoundCell As Range
Dim AfterCell As Range
Dim PossibleMatch As Boolean
Dim fCtr As Long
Dim myVal As Variant
Dim MatchStartingCol As Long
Dim UseThisRng As Range
HowManyParms = UBound(myParms) - LBound(myParms) + 1
Set TableRng = TableRng.Areas(1)
Set UseThisRng = Nothing
On Error Resume Next
Set UseThisRng = Intersect(TableRng.Parent.UsedRange.EntireRow, TableRng)
On Error GoTo 0
If UseThisRng Is Nothing Then
VLookupIfs = CVErr(xlErrRef)
Exit Function
End If
Set TableRng = UseThisRng
HowManyColsInTable = TableRng.Columns.Count
OkToContinue = True
If HowManyParms Mod 2 = 0 Then
'ok, it's an even number
Else
VLookupIfs = CVErr(xlErrRef)
OkToContinue = False
End If
WhichCol = CLng(WhichCol)
If WhichCol < 1 Then
VLookupIfs = CVErr(xlErrRef)
OkToContinue = False
End If
WhichMatch = CLng(WhichMatch)
If WhichMatch < 1 Then
VLookupIfs = CVErr(xlErrRef)
OkToContinue = False
End If
For iCtr = LBound(myParms) To UBound(myParms) Step 2
If IsNumeric(myParms(iCtr)) = False Then
OkToContinue = False
Exit For
Else
If myParms(iCtr) > HowManyColsInTable Then
OkToContinue = False
Exit For
Else
myParms(iCtr) = CDbl(myParms(iCtr))
End If
End If
Next iCtr
If OkToContinue = False Then
VLookupIfs = CVErr(xlErrRef)
Exit Function
End If
For iCtr = LBound(myParms) To UBound(myParms) Step 2
myFormula = myFormula & "--(" & _
TableRng.Columns(myParms(iCtr)).Address(external:=True) & "="
If TypeName(myParms(iCtr + 1)) = "String" Then
QtMark = """"
Else
QtMark = ""
End If
myFormula = myFormula & QtMark & myParms(iCtr + 1) & QtMark & "),"
Next iCtr
If myFormula = "" Then
'do nothing, something wrong
Else
'remove the trailing comma
myFormula = "sumproduct(" & Left(myFormula, Len(myFormula) - 1) & ")"
End If
HowManyMatches = TableRng.Parent.Evaluate(myFormula)
If WhichMatch > HowManyMatches Then
VLookupIfs = "Not enough matches"
Exit Function
End If
With TableRng.Columns(myParms(LBound(myParms)))
MatchStartingCol = .Column
fCtr = 0
Set AfterCell = .Cells(.Cells.Count)
Do
Set FoundCell = .Cells.Find(what:=myParms(LBound(myParms) + 1), _
After:=AfterCell, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
PossibleMatch = True
For iCtr = LBound(myParms) + 2 To UBound(myParms) Step 2
If lcase(FoundCell.Offset(0, myParms(iCtr) - MatchStartingCol) _
.Value) = lcase(myParms(iCtr + 1)) Then
'keep looking
Else
'a difference in one of the other columns
PossibleMatch = False
Exit For
End If
Next iCtr
If PossibleMatch = False Then
'don't increment match counter
Else
fCtr = fCtr + 1
End If
If fCtr = WhichMatch Then
'whew! done looking
myVal = FoundCell.Offset(0, WhichCol - MatchStartingCol).Value
Exit Do
Else
'keep looking after this match
Set AfterCell = FoundCell
End If
Loop
End With
VLookupIfs = myVal
End Function
========
The first portion of the code tries to do some rudimentary validity checks (but
not very many!).
The second portion builds a formula that it can use (=sumproduct) that can be
used to see how many matches there are in that table. If there are not enough,
you'll get an error. (Another validity check.)
Then the third portion does all the work. It does a .find to find the each
match in the "first" column that you specified. Then it looks at the other
columns to see if they matched the other specs. If they do, a fCtr variable is
incremented (all the columns have to match to increment that counter).
When the fCtr variable hits the number of the match you specified, then it picks
out the value from the column you want retrieved.
There is a small design error though.
=sumproduct() will distinguish between a number 3 and the text 3 (like '3). But
the .find() won't. You could check to see if the data types are the same (use
typename), but I didn't bother.
You'd use it in the worksheet cell like:
=vlookupifs('Sheet 999'!A1:Z99, 3, 7, 4, "A", 17, "Z", 26, 22)
Look in Sheet 999 A1:Z999
Bring back the 3rd column of that range (column C since I started in column A)
For the 7th match where
column 4 (D) = A
column 17 (Q) = "Z" (text)
column 26 (Z) = 22 (a number)
By using paramarray in this line:
Public Function VLookupIfs(TableRng As Range, _
WhichCol As Long, _
WhichMatch As Long, _
ParamArray myParms() As Variant) As Variant
You can continue adding pairs of columns/criteria (30 parms total, so about 13
more criteria parms).
============
If you're using xl2k or below, I think I'd keep as many validation checks, but
then just cycle through the columns looking for matches.
