A former collegue created a custom function which would work like vlookup but
find the specified instance of the data being searched instead of being
limited to just the first instance.
Example: VWLookup(PolicyDataSource,"Anderson",5,3)

This would find the 3rd instance of Anderson in the named range
"PolicyDataSource" and pull in the data from the 5th column.

Is there a way to customize this function to allow for an additional
criteria to search on? For example, if column 3 is policy_status and I want
to filter for 'Active'.

Any help is appreciated!


Public Function VWLookup(Table_Array As Object, _
Lookup_Value As Variant, Col_Index_Num As Integer, _
Match_Number As Integer) As Variant

Dim i, j As Integer

On Error GoTo ErrorCatch

For i = 1 To Match_Number
j = Application.Match(Lookup_Value,
Table_Array.Resize(Table_Array.Rows.Count, 1), 0)

If i = Match_Number Then
VWLookup = Application.VLookup(Lookup_Value, Table_Array,
Col_Index_Num, 0)
Exit Function
End If

Set Table_Array = Table_Array.Offset(j,
0).Resize(Table_Array.Rows.Count - j)

Next i

ErrorCatch:
VWLookup = "N/A"
End Function

Any takers on this? I could certainly use the help - I don't know how to
modify this myself...

"Robin" wrote:

A former collegue created a custom function which would work like vlookup but
find the specified instance of the data being searched instead of being
limited to just the first instance.
Example: VWLookup(PolicyDataSource,"Anderson",5,3)

This would find the 3rd instance of Anderson in the named range
"PolicyDataSource" and pull in the data from the 5th column.

Is there a way to customize this function to allow for an additional
criteria to search on? For example, if column 3 is policy_status and I want
to filter for 'Active'.

Any help is appreciated!


Public Function VWLookup(Table_Array As Object, _
Lookup_Value As Variant, Col_Index_Num As Integer, _
Match_Number As Integer) As Variant

Dim i, j As Integer

On Error GoTo ErrorCatch

For i = 1 To Match_Number
j = Application.Match(Lookup_Value,
Table_Array.Resize(Table_Array.Rows.Count, 1), 0)

If i = Match_Number Then
VWLookup = Application.VLookup(Lookup_Value, Table_Array,
Col_Index_Num, 0)
Exit Function
End If

Set Table_Array = Table_Array.Offset(j,
0).Resize(Table_Array.Rows.Count - j)

Next i

ErrorCatch:
VWLookup = "N/A"
End Function

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.



Robin wrote:

Any takers on this? I could certainly use the help - I don't know how to
modify this myself...

"Robin" wrote:

A former collegue created a custom function which would work like vlookup but
find the specified instance of the data being searched instead of being
limited to just the first instance.
Example: VWLookup(PolicyDataSource,"Anderson",5,3)

This would find the 3rd instance of Anderson in the named range
"PolicyDataSource" and pull in the data from the 5th column.

Is there a way to customize this function to allow for an additional
criteria to search on? For example, if column 3 is policy_status and I want
to filter for 'Active'.

Any help is appreciated!


Public Function VWLookup(Table_Array As Object, _
Lookup_Value As Variant, Col_Index_Num As Integer, _
Match_Number As Integer) As Variant

Dim i, j As Integer

On Error GoTo ErrorCatch

For i = 1 To Match_Number
j = Application.Match(Lookup_Value,
Table_Array.Resize(Table_Array.Rows.Count, 1), 0)

If i = Match_Number Then
VWLookup = Application.VLookup(Lookup_Value, Table_Array,
Col_Index_Num, 0)
Exit Function
End If

Set Table_Array = Table_Array.Offset(j,
0).Resize(Table_Array.Rows.Count - j)

Next i

ErrorCatch:
VWLookup = "N/A"
End Function


--

Dave Peterson