Lookup Table and output three or more entries

[dd]

Hi I'm trying to create a formula or macro that outputs three results. There
is a data validation, and once the type is selected, the formula would go
through the table on another sheet in the workbook and look for a match for
that type. Once found, it will populate three vendors with largest spend and
their addresses.
For example.
If the type was Apple. It would look through a long list with these headers
and the output would be Vendor A, B, and C and their addresses. If there is
only one vendor for that type then only one vendor name would show up but if
none then it would be blank.

Type Vendor Name Spend Address City ST Zip
Apple VendorA 500 any any any any
Apple VendorB 100
Apple VendorC 25
Apple VendorD 10
Orange VendorE 85
Orange VendorF 40
Lime VendorG 5
Lime VendorH 2
and so on ...
'
Thank you

 

[Joel]

Here is a UDF. Call with

=GetVendors("sheet1","Apple")


Function GetVendors(ShtName, VType)

'Indicates the the row numbers with the 3 highest Spent
'first index 3 are for the three highest spend
'second index is 0 for Spend Amount and
'1 for Row on spreadsheet
Dim RowRange(3, 2)
RowRange(0, 0) = -1
RowRange(1, 0) = -1
RowRange(2, 0) = -1

With Sheets(ShtName)
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
RowCount = 1
Do While RowCount <= LastRow
If .Range("A" & RowCount) = VType Then
Spend = .Range("C" & RowCount)
'put highest rows in order
'RowRange(0) gets highest
'RowRange(1) gets 2nd highest
'RowRange(2) gets 3rd highest

Select Case Spend
Case Is > RowRange(0, 0)
RowRange(2, 0) = RowRange(1, 0)
RowRange(1, 0) = RowRange(0, 0)
RowRange(0, 0) = Spend

RowRange(2, 1) = RowRange(1, 1)
RowRange(1, 1) = RowRange(0, 1)
RowRange(0, 1) = RowCount
Case Is > RowRange(1, 0)
RowRange(2, 0) = RowRange(1, 0)
RowRange(1, 0) = Spend

RowRange(2, 1) = RowRange(1, 1)
RowRange(1, 1) = RowCount
Case Is > RowRange(2, 0)
RowRange(2, 0) = Spend

RowRange(2, 1) = RowCount
End Select
End If
RowCount = RowCount + 1
Loop

'create return string
GetVendors = ""
For i = 0 To 2
If RowRange(i, 0) <> -1 Then
'add return if results isn't blank
If GetVendors <> "" Then
GetVendors = GetVendors & Chr(10)
End If
VendorName = .Range("B" & RowRange(i, 1))
VendorAddr = .Range("D" & RowRange(i, 1))
VendorCity = .Range("E" & RowRange(i, 1))
VendorState = .Range("F" & RowRange(i, 1))
VendorZip = .Range("G" & RowRange(i, 1))

GetVendors = GetVendors & _
VendorName & " - " & _
VendorAddr & " " & _
VendorCity & ", " & _
VendorState & " " & _
VendorZip
End If
Next i
End With

End Function

 

[dd]

Thanks Joel

I came up with another method but I will try your UDF later.

Thanks again
dd