Generate related lists of products that have similar attributes

[camspy]

We have a list of products in column A.
Each product has its set of attributes in column B.

The task is to generate a product with its 6 related products (in column C), which have similar attributes to that product, sorted by similarity.

Similar attributes mean that the products share a similar set of attributes. The more matching attributes, the more similar the product is.

Then, the most similar product goes to the top of the list, and the least similar product goes to the bottom.

The result should exclude the product for which we generated the list.

I provide sample data below.
In C2, I have put an example of what the result should look like.

sort.xlsx
	A	B	C
1	Product	Atributes	Result: 6 related products
2	Apple	packaging,quantity,reliability,size,design,material,id,content	Pear,Orange,Lemon,Fig,Lime,Lychee
3	Apricot	make,content,brand,purpose,feel,color,id,photos,weight,packaging
4	Avocado	reliability,size,design,taste,smell,feel
5	Banana	quantity,design,safety,brand,smell,id,feel,photos
6	Durian	size,color,content,feel,smell,quantity,brand,price,reliability
7	Fig	packaging,safety,weight,id,videos,photos
8	Grapefruit	weight,purpose,photos,packaging,material,make,color,content,videos,taste
9	Grapes	quantity,reliability,size,make,material,purpose,content,price
10	Lemon	packaging,reliability,design,weight,smell,photos
11	Lime	packaging,quantity,weight,make,taste,material,price,feel
12	Lychee	weight,content,taste,reliability,design,material,size,price,purpose,feel
13	Mango	taste,material,purpose,feel,videos,photos
14	Nectarine	reliability,size,safety,make,material,content,color,photos
15	Orange	packaging,quantity,reliability,make,purpose,smell,videos,photos
16	Papaya	size,design,weight,purpose,id,content
17	Peach	design,safety,content,price,feel,photos,price
18	Pear	packaging,design,safety,taste,purpose,price
19	Pineapple	safety,taste,content,price,feel,photos
20	Plum	reliability,size,make,material,content,color,price,photos
21	Watermelon	packaging,quantity,safety,brand,make,taste,material,content
Sheet1

Thanks in advance.

 

[kvsrinivasamurthy]

Here is the code foe UDF

Function GetRelatedProducts(RngPrd As Range, Rng As Range, CriPrd As String, CriAtb As String)
Dim M, N, temp
Dim Ta As Long, T As Long, K As Long, Cnt As Long
M = Split(CriAtb, ",")

Cnt = Rng.Cells.Count
ReDim Tly(1 To Cnt) As Long
With CreateObject("scripting.dictionary")

For Ta = 1 To Cnt
For T = 0 To UBound(M)
Tly(Ta) = Tly(Ta) + Evaluate("1*ISnumber(FIND(""" & M(T) & """," & Rng.Cells(Ta, 1).Address & "))")
Next T
.Add Tly(Ta) * 1000 - Ta, RngPrd.Cells(Ta, 1)
Next Ta

For Ta = 1 To Cnt
K = Application.Large(.keys, Ta)
If K > 0 And .Item(K) <> CriPrd Then
temp = temp & "," & .Item(K)
End If
Next Ta
End With
If temp = "" Then GetRelatedProducts = "" Else GetRelatedProducts = Mid(temp, 2)
End Function

Formula in C2 then copied down

=GetRelatedProducts($A$2:$A$9,$B$2:$B$9,$A2,$B2)

How to Use UDF code:
In the developer tab click--> Visual Basic
VB window opens
Insert--> Module
Paste the code.
Close the VB window.
Now UDF is available in Function List

 

[camspy]

@kvsrinivasamurthy Thanks for your help.

How do I specify the number of desired related results?
I now get lots of them, while I only need 6 for each product.

 

[kvsrinivasamurthy]

It is night and bed time for me. I will look into it tomorrow.

 

[camspy]

It is night and bed time for me. I will look into it tomorrow.

Sure thing, have a good night.

 

[kvsrinivasamurthy]

Revised code for UDF.

Function GetRelatedProducts(RngPrd As Range, Rng As Range, CriPrd As String, CriAtb As String)
Dim M, N, temp
Dim Ta As Long, T As Long, K As Long, Cnt As Long
M = Split(CriAtb, ",")

Cnt = Rng.Cells.Count
ReDim Tly(1 To Cnt) As Long
With CreateObject("scripting.dictionary")

For Ta = 1 To Cnt
For T = 0 To UBound(M)
Tly(Ta) = Tly(Ta) + Evaluate("1*ISnumber(FIND(""" & M(T) & """," & Rng.Cells(Ta, 1).Address & "))")
Next T
.Add Tly(Ta) * 1000 - Ta, RngPrd.Cells(Ta, 1)
Next Ta

For Ta = 1 To WorksheetFunction.Min(7, Cnt)
K = Application.Large(.keys, Ta)
If K > 0 And .Item(K) <> CriPrd Then
temp = temp & "," & .Item(K)
End If
Next Ta
End With
If temp = "" Then GetRelatedProducts = "" Else GetRelatedProducts = Mid(temp, 2)
End Function

 

[camspy]

Revised code for UDF.

Function GetRelatedProducts(RngPrd As Range, Rng As Range, CriPrd As String, CriAtb As String)
Dim M, N, temp
Dim Ta As Long, T As Long, K As Long, Cnt As Long
M = Split(CriAtb, ",")

Cnt = Rng.Cells.Count
ReDim Tly(1 To Cnt) As Long
With CreateObject("scripting.dictionary")

For Ta = 1 To Cnt
For T = 0 To UBound(M)
Tly(Ta) = Tly(Ta) + Evaluate("1*ISnumber(FIND(""" & M(T) & """," & Rng.Cells(Ta, 1).Address & "))")
Next T
.Add Tly(Ta) * 1000 - Ta, RngPrd.Cells(Ta, 1)
Next Ta

For Ta = 1 To WorksheetFunction.Min(7, Cnt)
K = Application.Large(.keys, Ta)
If K > 0 And .Item(K) <> CriPrd Then
temp = temp & "," & .Item(K)
End If
Next Ta
End With
If temp = "" Then GetRelatedProducts = "" Else GetRelatedProducts = Mid(temp, 2)
End Function

Thank you for your time and effort!

I had to check how well the sorting from the most similar product to the least similar product works.
I've did a test with 200+ products that have up to 50 attributes. I picked one product and analyzed the results.
The related products for it were sorted this way: 17,17,11,5,15,15.
Those are the numbers of matching attributes.

I would have expected the sorting to be like this: 17,17,15,15,11,5.

 

[bebo021999]

Try the UDF =CPcount(Product,Range_of_Products,Number_of_common)
=CPcount(A2,$B$2:$B$21,6)

Option Explicit
Function CPcount(ByVal target As Range, ByVal rng As Range, ByVal N As Long)
Dim i&, j&, k&, Lr&, max&, count&, cell As Range
Dim st1, st2 As String, arr(), pr
Lr = rng.Rows.count
ReDim arr(1 To Lr, 1 To 2)
st1 = Split(target.Offset(0, 1), ",")
     For Each cell In rng.Offset(0, -1)
     If cell.Value <> target.Value Then
        st2 = "," & cell.Offset(, 1).Value & ","
        For j = 0 To UBound(st1)
            If InStr(1, st2, "," & st1(j) & ",") > 0 Then count = count + 1
        Next
        k = k + 1
        arr(k, 1) = count
        arr(k, 2) = cell
        st2 = ""
        count = 0
    End If
    Next
    For i = 1 To Lr - 1
        For j = i + 1 To Lr
        If arr(j, 1) > arr(i, 1) Then
            max = arr(j, 1)
            pr = arr(j, 2)
            arr(j, 1) = arr(i, 1): arr(j, 2) = arr(i, 2)
            arr(i, 1) = max: arr(i, 2) = pr
        End If
        Next
    Next
st2 = ""
For i = 1 To N
st2 = st2 & ", " & arr(i, 2) & "(" & arr(i, 1) & ")" ' product and count. If product only, use: st2 = st2 & ", " & arr(i, 2)
Next
CPcount = Right(st2, Len(st2) - 1)
End Function

Note that the output like: " Grapes(5), Lychee(5), Durian(4), Nectarine(4), Papaya(4), Plum(4)"
If the output likes: " Grapes, Lychee, Durian, Nectarine, Papaya, Plum", the 4th line from bottom should be:
st2 = st2 & ", " & arr(i, 2)

 

[camspy]

Try the UDF =CPcount(Product,Range_of_Products,Number_of_common)
=CPcount(A2,$B$2:$B$21,6)

Option Explicit
Function CPcount(ByVal target As Range, ByVal rng As Range, ByVal N As Long)
Dim i&, j&, k&, Lr&, max&, count&, cell As Range
Dim st1, st2 As String, arr(), pr
Lr = rng.Rows.count
ReDim arr(1 To Lr, 1 To 2)
st1 = Split(target.Offset(0, 1), ",")
     For Each cell In rng.Offset(0, -1)
     If cell.Value <> target.Value Then
        st2 = "," & cell.Offset(, 1).Value & ","
        For j = 0 To UBound(st1)
            If InStr(1, st2, "," & st1(j) & ",") > 0 Then count = count + 1
        Next
        k = k + 1
        arr(k, 1) = count
        arr(k, 2) = cell
        st2 = ""
        count = 0
    End If
    Next
    For i = 1 To Lr - 1
        For j = i + 1 To Lr
        If arr(j, 1) > arr(i, 1) Then
            max = arr(j, 1)
            pr = arr(j, 2)
            arr(j, 1) = arr(i, 1): arr(j, 2) = arr(i, 2)
            arr(i, 1) = max: arr(i, 2) = pr
        End If
        Next
    Next
st2 = ""
For i = 1 To N
st2 = st2 & ", " & arr(i, 2) & "(" & arr(i, 1) & ")" ' product and count. If product only, use: st2 = st2 & ", " & arr(i, 2)
Next
CPcount = Right(st2, Len(st2) - 1)
End Function

Note that the output like: " Grapes(5), Lychee(5), Durian(4), Nectarine(4), Papaya(4), Plum(4)"
If the output likes: " Grapes, Lychee, Durian, Nectarine, Papaya, Plum", the 4th line from bottom should be:
st2 = st2 & ", " & arr(i, 2)

I've tried both variants, but I get #NAME?

 

[bebo021999]

I've tried both variants, but I get #NAME?

Have you put code in module?
Could u share the screenshot of cell with UDF?