Oh! OKAY,
I was thinking of a worksheet function but if we could get this into
the FindMatch function that would be great
Function FindMatch(Rises As Integer, Rise As Single, Run As Single, _
OSM As Single, RoutesCuts As String) As Variant
'Looks on sheet 1 for record that has number of rises, rise, etc.
respectively, in
'columns C:G. If number of rises not found, looks for next higher
number.
'This is an array function that yields in successive row elements
' 1. "Exact Match", "Approx. Match", "No Match"
' 2. Number of rises found (0 if no match)
' 3. Row number in which match was found (0 if no match)
Dim A(1 To 3, 1 To 1) As Variant
Dim Temp As Variant
Dim LastRow As Long
Dim iRow As Long
Dim mRow As Long 'the nearest match row found so far
Dim mRises As Integer 'the smallest number of rises found so
far
mRises = 999
A(1, 1) = "No Match"
A(2, 1) = 0
A(3, 1) = 0
With Worksheets("Sheet1")
LastRow = .[C65536].End(xlUp).Row
For iRow = 2 To LastRow
'Check criteria right to left
If .Cells(iRow, "G") = RoutesCuts Then
If .Cells(iRow, "F") = OSM Then
If .Cells(iRow, "E") = Run Then
If .Cells(iRow, "D") = Rise Then
If .Cells(iRow, "C") >= Rises Then
If .Cells(iRow, "C") = Rises Then
A(1, 1) = "Exact Match"
A(2, 1) = Rises
A(3, 1) = iRow
GoTo Done
Else
If .Cells(iRow, "C") < mRises Then
mRises = .Cells(iRow, "C")
mRow = iRow
End If
End If
End If
End If
End If
End If
End If
Next iRow
If mRow = 0 Then
mRises = 0
GoTo Done
End If
A(1, 1) = "Approx. Match"
A(2, 1) = mRises
A(3, 1) = mRow
End With
Done:
Temp = A
FindMatch = Temp
End Function
