Calculate Recurring Items

[default_name]

If I have a spreadsheet like this (below), is there a way to display the top recurring item (from cells A, B and C) in the cells in Column D, like so?
I added notes on the right side.

	A	B	C	D
1	Group A Item(s)	Group B Item(s)	Group D Item(s)	Top Recurring Item
2	Apple Orange Taco	Cheese	Apple Mayo Ham	Apple	<--This is an example of ONE obvious result...since all items are listed only once, except Apple (which appears twice)
3	Apple Beef Cheese Soda	Soda Plum Cups	Apple Soda Chili	Soda	<--Although Soda appears 3 times, and Apple appears 2 times, Soda would be outputted since 3>2
4	Orange Chicken Flour	Spam	Mayo Parsely	No Recurring Items	<--Since there aren't any recurring items in these cells, the result is just text stating the obvious
5	Tomato Flour Mustard Fries Bread	Taco Turkey Flour	Bread Corn	Bread Flour	<--This is an example of a tie. Bread appears twice, as does Flour. As a result of a tie, both Bread and Flour are outputted.

<tbody>
</tbody>

Is this even possible?
Thanks in advance for your help!

 

[DanteAmor]

Try this UDF

The code assumes each data within the cell is separated by Alt + Enter (char 10), as shown in your example.

Function [COLOR=#0000ff]TopRecurringItem[/COLOR](r As Range)
  Dim c, d, dict As Object, ky, wmax As Long, cad As String
  Set dict = CreateObject("scripting.dictionary")
  For Each c In r
    For Each d In Split(c, Chr(10))
      If Not dict.exists(d) Then
        dict(d) = 1
      Else
        dict(d) = Val(dict(d)) + 1
        If dict(d) > wmax Then wmax = dict(d)
      End If
    Next
  Next
  For Each ky In dict.keys
    If dict(ky) = wmax Then cad = cad & ky & Chr(10)
  Next
  TopRecurringItem = cad
End Function

HOW TO INSTALL UDFs
------------------------------------
If you are new to UDFs, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. You can now use TopRecurringItem just like it was a built-in Excel function. For example,

=TopRecurringItem(A2:C2)

 

[default_name]

Thanks for your help!
That works perfectly (given the example I provided above).
In my actual data (not actually using random items or food) there are occasionally some cells that have error (#VALUE!) cells due to various other factors.
These cells create a problem. Is there any way to work around these?
Like so (see the red and green examples):

Right now it looks/functions like this:

	A	B	C	D
1	Group A Item(s)	Group B Item(s)	Group D Item(s)	Top Recurring Item
2	Apple Orange Taco	Cheese	Apple Mayo Ham	Apple	<--This is an example of ONE obvious result...since all items are listed only once, except Apple (which appears twice)
3	Apple Beef Cheese Soda	Soda Plum Cups	Apple Soda Chili	Soda	<--Although Soda appears 3 times, and Apple appears 2 times, Soda would be outputted since 3>2
4	Orange Chicken Flour	Spam	Mayo Parsely	No Recurring Items	<--Since there aren't any recurring items in these cells, the result is just text stating the obvious
5	Tomato Flour Mustard Fries Bread	Taco Turkey Flour	Bread Corn	Bread Flour	<--This is an example of a tie. Bread appears twice, as does Flour. As a result of a tie, both Bread and Flour are outputted.
6	Bread Mayo	#VALUE!	Bread Cheese	#VALUE!
7	#VALUE!	Spam	#VALUE!	#VALUE!

<tbody>
</tbody>

I would like it to function like this:

	A	B	C	D
1	Group A Item(s)	Group B Item(s)	Group D Item(s)	Top Recurring Item
2	Apple Orange Taco	Cheese	Apple Mayo Ham	Apple	<--This is an example of ONE obvious result...since all items are listed only once, except Apple (which appears twice)
3	Apple Beef Cheese Soda	Soda Plum Cups	Apple Soda Chili	Soda	<--Although Soda appears 3 times, and Apple appears 2 times, Soda would be outputted since 3>2
4	Orange Chicken Flour	Spam	Mayo Parsely	No Recurring Items	<--Since there aren't any recurring items in these cells, the result is just text stating the obvious
5	Tomato Flour Mustard Fries Bread	Taco Turkey Flour	Bread Corn	Bread Flour	<--This is an example of a tie. Bread appears twice, as does Flour. As a result of a tie, both Bread and Flour are outputted.
6	Bread Mayo	#VALUE!	Bread Cheese	Bread
7	#VALUE!	Spam	#VALUE!	Spam

<tbody>
</tbody>

Basically, if it is one of those weird errored cells, is there any way to simply ignore them in the column C formula?

Thanks for your help!

 

[DanteAmor]

Try this

Function TopRecurringItem(r As Range)
  Dim c, d, dict As Object, ky, wmax As Long, cad As String
  Set dict = CreateObject("scripting.dictionary")
  For Each c In r
    If Not IsError(c) Then
      For Each d In Split(c, Chr(10))
        If Not dict.exists(d) Then
          dict(d) = 1
        Else
          dict(d) = Val(dict(d)) + 1
          If dict(d) > wmax Then wmax = dict(d)
        End If
      Next
    End If
  Next
  For Each ky In dict.keys
    If dict(ky) = wmax Then cad = cad & ky & Chr(10)
  Next
  TopRecurringItem = cad
End Function

 

[Peter_SSs]

That works perfectly (given the example I provided above).

With two provisos ..
- You don't mind not having the "stating the obvious" text you seemed to want in row 4, and
- You don't mind having an extra carriage return at the end of the result cell. It may be possible this could cause a problem if using these results elsewhere in code or formula.

I also assume that the last result in your table at the bottom of post 3 is a mistake. Otherwise I don't understand why row 4 has no recurring items but row 7 gets one even though Spam doesn't recur.

My suggestion is somewhat similar to Dante's but addresses the points made above & 'compacts' some of the dictionary manipulation code lines.
It does assume that you have the TEXTJOIN function in your Excel version.

Function Most(r As Range) As String
  Dim d As Object
  Dim itm As Variant
  Dim MaxCount As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  For Each itm In Split(Evaluate(Replace("textjoin(char(10),1,if(istext(#),#,""""))", "#", r.Address)), Chr(10))
    If Not IsError(itm) Then
      d(itm) = d(itm) + 1
      If d(itm) > MaxCount Then MaxCount = MaxCount + 1
    End If
  Next itm
  If MaxCount < 2 Then
    Most = "No Recurring Items"
  Else
    For Each itm In d.Keys
      If d(itm) = MaxCount Then Most = Most & Chr(10) & itm
    Next itm
    Most = Mid(Most, 2)
  End If
End Function

Excel Workbook
	A	B	C	D
1	Group A Item(s)	Group B Item(s)	Group D Item(s)	Top Recurring Item
2	AppleOrangeTaco	Cheese	AppleMayoHam	Apple
3	AppleBeefCheeseSoda	SodaPlumCups	AppleSodaChili	Soda
4	OrangeChickenFlour	Spam	MayoParsely	No Recurring Items
5	TomatoFlourMustardFriesBread	TacoTurkeyFlour	BreadCorn	FlourBread
6	BreadMayo	#VALUE!	BreadCheese	Bread
7	Mayo		Cheese	No Recurring Items
8	#VALUE!	Spam	#VALUE!	No Recurring Items
Most

 

[default_name]

Thanks guys!
Dante, thanks for the quick response. It works well!

Peter, you are very right. I should've rephrased my initial post. Although the last result only has one occurrence (no recurrence), I was hoping for just that one (non-error) occurrence to output.
Thank you for adding in the "No Recurring Items" text. I will try and find a way to mix that in with Dante's code.
I also dont have TextJoin in my Excel version, so I couldn't test out your code.

I really appreciate your guys' time and help! It is very much appreciated! You're awesome!

 

[DanteAmor]

Dante, thanks for the quick response. It works well!

adding in the "No Recurring Items" text. I will try and find a way to mix that in with Dante's code.

Hi @default_name , Use the following to add the text.

Function TopRecurringItem(r As Range)
  Dim c, d, dict As Object, ky, wmax As Long, cad As String
  Set dict = CreateObject("scripting.dictionary")
  For Each c In r
    If Not IsError(c) Then
      For Each d In Split(c, Chr(10))
        If Not dict.exists(d) Then
          dict(d) = 1
        Else
          dict(d) = Val(dict(d)) + 1
          If dict(d) > wmax Then wmax = dict(d)
        End If
      Next
    End If
  Next
  For Each ky In dict.keys
    If dict(ky) = wmax Then cad = cad & ky & Chr(10)
  Next
  TopRecurringItem = [COLOR=#0000ff]IIf(cad = "", "No Recurring Items", cad)[/COLOR]
End Function