Most of the functions to find or lookup a value on a worksheet stop when they
hit the first match. That is why your VLOOKUP() doesn't work the way you
expect. Since you may have 1 or many new products based on an old product,
it creates a problem in creating a formula that looks up a variable number of
matches in a list of unknown length and unknown order.
Because of this, I created what is known as a User Defined Function (UDF) to
let you identify any new product number and return a list of all new products
that are based on the same old product number.
So if you enter 1546 (or reference cell C2) then it will return:
1546 | prod01
but if you enter 1556 (or reference cell C3) then it would return:
1556 | prod02 : 1559 | prod02b : 1561 | prod02c
The code below has been set up so that you can change the values for the
Const values declared to work with your actual worksheet setup. To put it
into use: open the workbook and press [Alt]+[F11] to open the Visual Basic
Editor (VBE). Then choose Insert | Module and copy the code below and paste
it into the new module presented to you. Make any changes to the Const
values that you need to and then close the VBE.
If your worksheet is set up like your example explains, put this formula in
cell E2:
=GetAllNames(C2)
and you should see "1546 | prod01" in that cell. If you fill the formula on
down the sheet, you'll see the other entries appear. The formula at E3 would
be
=GetAllNames(C3) and it should display
1556 | prod02 : 1559 | prod02b : 1561 | prod02c
in E3.
If you wanted to be able to type in a new product number and find out all of
the new products that are based on the same old product number you could pick
a pair of cells such as G1 and H1. You would put the formula
=GetAllNames(G1) into cell H1 and then type in new product numbers into G1
and see the related products show up in H1.
Hope this helps some. Here is the code:
Function GetAllNames(newProdNumber As String) As String
'INPUT: the new product number
' could be a literal value or reference to a cell with
' a new product number in it like:
' =GetAllNames("1556")
' or
' =GetAllNames(C3)
'OUTPUT: a list of all product numbers and names
' that share the same old product number
Const oldProdNumCol = "A"
Const newProdNumCol = "C"
Const newProdNameCol = "D"
Const firstRowOfData = 2
Dim newProdNumList As Range
Dim anyNewProdNum As Range
Dim oldProdNumList As Range
Dim anyOldProdNum As Range
' from new number col to old number col
Dim offsetToOldNumber As Integer
' from old number col to new number col
Dim offsetToNewNumber As Integer
' from old number col to new name col
Dim offsetToNewName As Integer
' row new number found on
Dim foundNewRow As Long
Dim foundOldProdNum As Variant
offsetToOldNumber = Range(oldProdNumCol & _
firstRowOfData).Column - _
Range(newProdNumCol & firstRowOfData).Column
' reverse sign to get offset the other way
offsetToNewNumber = offsetToOldNumber * -1
offsetToNewName = Range(newProdNameCol & _
firstRowOfData).Column - _
Range(oldProdNumCol & firstRowOfData).Column
Set newProdNumList = Range(newProdNumCol & _
firstRowOfData & ":" & _
Range(newProdNumCol & _
Rows.Count).End(xlUp).Address)
Set oldProdNumList = Range(oldProdNumCol & _
firstRowOfData & ":" & _
Range(oldProdNumCol & _
Rows.Count).End(xlUp).Address)
'find the new number in the list
foundNewRow = 0
For Each anyNewProdNum In newProdNumList
If anyNewProdNum = newProdNumber Then
foundNewRow = anyNewProdNum.Row
Exit For ' finished looking
End If
Next
If foundNewRow = 0 Then
'did not find match, quit
GetAllNames = "No Match Found"
Exit Function
End If
foundOldProdNum = _
anyNewProdNum.Offset(0, offsetToOldNumber)
'have to look in all of these each time
For Each anyOldProdNum In oldProdNumList
If anyOldProdNum = foundOldProdNum Then
GetAllNames = GetAllNames & _
anyOldProdNum.Offset(0, offsetToNewNumber) & _
" | " & _
anyOldProdNum.Offset(0, offsetToNewName) & _
" : "
End If
Next
'remove the extra " : " at the end of the list
If Right(GetAllNames, 3) = " : " Then
GetAllNames = Left(GetAllNames, _
Len(GetAllNames) - 3)
End If
'cleanup
Set newProdNumList = Nothing
Set oldProdNumList = Nothing
End Function
