UDF for Three Parameter hlookup

[mduff]

Hi,

I found this code on the internet for a UDF for a Three Parameter Vlookup this is almost what i need but I need it to do a hlookup with Three Parameters unfortunately I am not skilled enough to change it

Re examining this I would need it for 2 and 3 Parameters

Any help would be very appreciated


[vba]
Function ThreeParameterVlookup(Data_Range As Range, Col As Integer, Parameter1 As Variant, _
Parameter2 As Variant, Parameter3 As Variant) As Variant
'Declare Variables
Dim Cell
Dim Current_Row As Integer
Dim No_Of_Rows_in_Range As Integer
Dim No_of_Cols_in_Range As Integer
Dim Matching_Row As Integer

'set answer to N/A by default
ThreeParameterVlookup = CVErr(xlErrNA)
Matching_Row = 0
Current_Row = 1

No_Of_Rows_in_Range = Data_Range.Rows.Count
No_of_Cols_in_Range = Data_Range.Columns.Count

'Check if Col is greater than number of columns in range

If (Col > No_of_Cols_in_Range) Then
ThreeParameterVlookup = CVErr(xlErrRef)
End If
If (Col <= No_of_Cols_in_Range) Then
Do
If ((Data_Range.Cells(Current_Row, 1).Value = Parameter1) And _
(Data_Range.Cells(Current_Row, 2).Value = Parameter2) And _
(Data_Range.Cells(Current_Row, 3).Value = Parameter3)) Then
Matching_Row = Current_Row

End If
Current_Row = Current_Row + 1
Loop Until ((Current_Row = No_Of_Rows_in_Range) Or (Matching_Row <> 0))

If Matching_Row <> 0 Then
ThreeParameterVlookup = Data_Range.Cells(Matching_Row, Col)
End If

End If

End Function
[/vba]
thanks in advance

[Aflatoon]

How about this:

Function ThreeParameterHLookup(Data_Range As Range, RowNum As Long, Parameter1 As Variant, _
    Parameter2 As Variant, Parameter3 As Variant) As Variant
     'Declare Variables
    Dim Cell
    Dim Current_Col As Long
    Dim No_Of_Rows_in_Range As Long
    Dim No_of_Cols_in_Range As Long
    Dim Matching_Col As Long
 
     'set answer to N/A by default
    ThreeParameterHLookup = CVErr(xlErrNA)
    Matching_Col = 0
    Current_Col = 1
 
    No_Of_Rows_in_Range = Data_Range.Rows.Count
    No_of_Cols_in_Range = Data_Range.Columns.Count
 
     'Check if Col is greater than number of columns in range
 
    If (RowNum > No_Of_Rows_in_Range) Then
        ThreeParameterHLookup = CVErr(xlErrRef)
    Else
        Do
            If ((Data_Range.Cells(1, Current_Col).Value = Parameter1) And _
            (Data_Range.Cells(2, Current_Col).Value = Parameter2) And _
            (Data_Range.Cells(3, Current_Col).Value = Parameter3)) Then
                Matching_Col = Current_Col
 
            End If
            Current_Col = Current_Col + 1
        Loop Until ((Current_Col = No_of_Cols_in_Range) Or (Matching_Col <> 0))
 
        If Matching_Col <> 0 Then
            ThreeParameterHLookup = Data_Range.Cells(RowNum, Matching_Col)
        End If
 
    End If
 
End Function

[Paul_Hossler]

Ever since 2007 went to million+ rows, I've been trying to stay away for loops. One way for the VLookup and the HLookup

[VBA]
Option Explicit
Function ThreeParameterVlookup(DataRange As Range, ColNum As Integer, _
Parameter1 As Variant, _
Parameter2 As Variant, _
Parameter3 As Variant) As Variant

Dim rCell As Range, rData As Range
Dim iP1 As Long, iP2 As Long, iP3 As Long, iMaxP As Long


On Error GoTo HandleError

'Check if Col is greater than number of columns in range
If ColNum > DataRange.Columns.Count Then Err.Raise 10000


Set rData = Intersect(DataRange, DataRange.Parent.UsedRange)

'set working range to bottom of input range since
'first possible 3 way match begins with the bottom most
'column match value
iP1 = -1
iP2 = -2
iP3 = -3
iMaxP = 1

While (iP1 <> iP2) And (iP2 <> iP3) And (iP3 <> iP1)

'set working range = last matched value to bottom
Set rData = rData.Cells(iMaxP, 1).Resize(rData.Rows.Count - iMaxP + 1, rData.Columns.Count)

'Check if all 3 parms are in the input range. Handle as error if not
With Application.WorksheetFunction
iP1 = .Match(Parameter1, rData.Columns(1), 0)
iP2 = .Match(Parameter2, rData.Columns(2), 0)
iP3 = .Match(Parameter3, rData.Columns(3), 0)
iMaxP = .Max(iP1, iP2, iP3)
End With

Wend

ThreeParameterVlookup = rData(iP1, ColNum)

Exit Function

HandleError:
'not Matched
If Err.Number = 1004 Then
ThreeParameterVlookup = CVErr(xlErrNA)
'other error
Else
ThreeParameterVlookup = CVErr(xlErrRef)
End If
End Function
Function ThreeParameterHlookup(DataRange As Range, RowNum As Integer, _
Parameter1 As Variant, _
Parameter2 As Variant, _
Parameter3 As Variant) As Variant

Dim rCell As Range, rData As Range
Dim iP1 As Long, iP2 As Long, iP3 As Long, iMaxP As Long


On Error GoTo HandleError

'Check if Col is greater than number of columns in range
If RowNum > DataRange.Rows.Count Then Err.Raise 10000


Set rData = Intersect(DataRange, DataRange.Parent.UsedRange)

'set working range to bottom of input range since
'first possible 3 way match begins with the bottom most
'column match value
iP1 = -1
iP2 = -2
iP3 = -3
iMaxP = 1

While (iP1 <> iP2) And (iP2 <> iP3) And (iP3 <> iP1)

'set working range = last matched value to bottom
Set rData = rData.Cells(1, iMaxP).Resize(rData.Rows.Count, rData.Columns.Count - iMaxP + 1)

'Check if all 3 parms are in the input range. Handle as error if not
With Application.WorksheetFunction
iP1 = .Match(Parameter1, rData.Rows(1), 0)
iP2 = .Match(Parameter2, rData.Rows(2), 0)
iP3 = .Match(Parameter3, rData.Rows(3), 0)
iMaxP = .Max(iP1, iP2, iP3)
End With

Wend

ThreeParameterHlookup = rData(RowNum, iP1)

Exit Function

HandleError:
'not Matched
If Err.Number = 1004 Then
ThreeParameterHlookup = CVErr(xlErrNA)
'other error
Else
ThreeParameterHlookup = CVErr(xlErrRef)
End If
End Function
[/VBA]

Paul

[Aflatoon]

To be honest, I don't really know why you would use VBA for this anyway when you can do it with a LOOKUP formula.

[Paul_Hossler]

For the challenge, the thrills, the sense of adventure?



Personally, I find it easier to follow the logic in VBA than in a long, complicated WS formula

Paul

[Aflatoon]

=lookup(2, 1/((range1=crit1)*(range2=crit2)*(range3=crit3)),return_range)
not that long!
I do agree with you on the more 'ludicrous' (to my simple mind) formulas though!

Edit: note that of course the formula version above would not necessarily return the same values as the VBA version if there were multiple matches for the criteria.

[mduff]

thanks to all on the help