Most Occurring Text Multiple Criteria

Kris_

New Member
Joined
Aug 9, 2019
Messages
4
Hoping there is someone out there, with a genius mind in VBA or excel formulas.

I data set:

NameLocationOutcome
KrisBarbadosW
JohnGlasgowL
KrisBirminghamW
JohnBarbadosL
KrisBirminghamW
KrisLondonL
KrisLondonW
KrisLondonL
JohnLondonW

<tbody>
</tbody>


I want to show in another table the most successful location for Kris, in this instance it would be Birmingham with two wins, although London is most visited location for Kris. (See table below for example).

NameMost VisitedMost Successful
KrisLondonBirmingham
John-London

<tbody>
</tbody>
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Hi,
What if you had more then one record with the same most occurrence for most visited or/and most successfull? Ex.
John visited only London, Birmingam one time each - which one would you oick as a result for most visited?
John: London - W, Birmingam - L, Liverpool- W. Which one would you pick as a result of most successful?

Regards,
Sebastian
 
Upvote 0
Welcome to the MrExcel board!

Based on most visited for John, are you saying that if the first row for Kris was Birmingham instead of Barbados then most visited for Kris should show '-"? If not, what should the result be and how presented?

Similarly, if somebody has 2 or more equal 'most successful' what result do you want to show?

Edit: I see my questions have already been asked. :biggrin:
 
Last edited:
Upvote 0
Thanks for the response both.

If that were the case, then I'd just expect to see the first in the list really. Similar to how a normal index match works.
 
Upvote 0
This may be a result that you can use/Or you can live with.
Result start "F1".

Code:
[COLOR="Navy"]Sub[/COLOR] MG09Aug27
im Dn [COLOR="Navy"]As[/COLOR] Range, Rng [COLOR="Navy"]As[/COLOR] Range, Dic [COLOR="Navy"]As[/COLOR] Object, Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] nSum [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] p [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
 [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
        
        [COLOR="Navy"]If[/COLOR] Not Dic(Dn.Value).exists(Dn.Offset(, 1).Value) [COLOR="Navy"]Then[/COLOR]
               [COLOR="Navy"]If[/COLOR] Dn.Offset(, 2) = "W" [COLOR="Navy"]Then[/COLOR] nSum = 1
                Dic(Dn.Value).Add (Dn.Offset(, 1).Value), Array(nSum, 1)
        [COLOR="Navy"]Else[/COLOR]
                Q = Dic(Dn.Value).Item(Dn.Offset(, 1).Value)
                    [COLOR="Navy"]If[/COLOR] Dn.Offset(, 2) = "W" [COLOR="Navy"]Then[/COLOR] Q(0) = Q(0) + 1
                    Q(1) = Q(1) + 1
                Dic(Dn.Value).Item(Dn.Offset(, 1).Value) = Q
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
   
  
   c = 1
    ReDim ray(1 To Rng.Count, 1 To 4)
    ray(1, 1) = "Name": ray(1, 2) = "Visited": ray(1, 3) = "No Visits": ray(1, 4) = "Number of Wins"

    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
         [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
             c = c + 1
             ray(c, 1) = k
             ray(c, 2) = p
             ray(c, 3) = Dic(k).Item(p)(1)
             ray(c, 4) = Dic(k).Item(p)(0)
          [COLOR="Navy"]Next[/COLOR] p
   
    [COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]With[/COLOR] Range("F1").Resize(c, 4)
  .Value = ray
  .Borders.Weight = 2
  .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
@MickG

Thanks for the response, it is appreciated, but this does not do what I am looking for.

I am looking for the location name to appear rather than a count in another table.

I am hoping for something that can populate a field in another table for the individual for "Most Successful Location".
 
Upvote 0
If that were the case, then I'd just expect to see the first in the list really. Similar to how a normal index match works.
So, wouldn't we apply the same logic to John where he has 3 equal most visited so return the first one: Glasgow?

You could try these user-defined functions. To implement ..
1. Right click the sheet name tab and choose "View Code".
2. In the Visual Basic window use the menu to Insert|Module
3. Copy and Paste the code below into the main right hand pane that opens at step 2.
4. Close the Visual Basic window.
5. Enter the formulas as shown in the screen shot below and copy down.
6. Your workbook will need to be saved as a macro-enabled workbook (*.xlsm)

Code:
Function MostVisited(sName As String, rNames As Range, rlocations As Range) As String
  Dim d As Object
  Dim Maxnum As Long, i As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  sName = LCase(sName)
  For i = 1 To rNames.Rows.Count
    If LCase(rNames.Cells(i).Value) = sName Then d(rlocations.Cells(i).Value) = d(rlocations.Cells(i).Value) + 1
  Next i
  Maxnum = Application.Max(d.Items)
  i = 0
  Do
    MostVisited = d.keys()(i)
    i = i + 1
  Loop Until d.Items()(i - 1) = Maxnum
End Function

Function MostSuccessful(sName As String, rNames As Range, rlocations As Range, rOutcomes As Range) As String
  Dim d As Object
  Dim c As Range
  Dim Maxnum As Long, i As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  sName = LCase(sName)
  For i = 1 To rNames.Rows.Count
    If LCase(rNames.Cells(i).Value) = sName And LCase(rOutcomes.Cells(i).Value) = "w" Then d(rlocations.Cells(i).Value) = d(rlocations.Cells(i).Value) + 1
  Next i
  Maxnum = Application.Max(d.Items)
  i = 0
  Do
    MostSuccessful = d.keys()(i)
    i = i + 1
  Loop Until d.Items()(i - 1) = Maxnum
End Function

Excel Workbook
ABCDEFG
1NameLocationOutcomeNameMost VisitedMost Successful
2KrisBarbadosWKrisLondonBirmingham
3JohnGlasgowLJohnGlasgowLondon
4KrisBirminghamW
5JohnBarbadosL
6KrisBirminghamW
7KrisLondonL
8KrisLondonW
9KrisLondonL
10JohnLondonW
Most Common
 
Upvote 0
Although I see you have a successful answer, the below is a slight alternative to your answer.
Where there are duplicate counts of locations/Wins, those duplicates are shown together in the related cells.
Maybe useful to you ??
Results start "F1"
Code:
[COLOR="Navy"]Sub[/COLOR] MG09Aug27
[COLOR="Navy"]Dim[/COLOR] Dn [COLOR="Navy"]As[/COLOR] Range, Rng [COLOR="Navy"]As[/COLOR] Range, Dic [COLOR="Navy"]As[/COLOR] Object, Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] nSum [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] p [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] oMax2 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Num1 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] Num2 [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]

[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
 [COLOR="Navy"]Set[/COLOR] Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = 1
   [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
            nSum = 0
            [COLOR="Navy"]If[/COLOR] Not Dic.exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
                [COLOR="Navy"]Set[/COLOR] Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
            [COLOR="Navy"]End[/COLOR] If
        
        [COLOR="Navy"]If[/COLOR] Not Dic(Dn.Value).exists(Dn.Offset(, 1).Value) [COLOR="Navy"]Then[/COLOR]
               [COLOR="Navy"]If[/COLOR] Dn.Offset(, 2) = "W" [COLOR="Navy"]Then[/COLOR] nSum = 1
                Dic(Dn.Value).Add (Dn.Offset(, 1).Value), Array(1, nSum)
        [COLOR="Navy"]Else[/COLOR]
                Q = Dic(Dn.Value).Item(Dn.Offset(, 1).Value)
                    [COLOR="Navy"]If[/COLOR] Dn.Offset(, 2) = "W" [COLOR="Navy"]Then[/COLOR] Q(1) = Q(1) + 1
                    Q(0) = Q(0) + 1
                Dic(Dn.Value).Item(Dn.Offset(, 1).Value) = Q
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Dn
   
  
   c = 1
    ReDim ray(1 To Rng.Count, 1 To 3)
   
    ray(1, 1) = "Name": ray(1, 2) = "Most Visited": ray(1, 3) = "Most Successful"
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
         oMax = 0: oMax2 = 0
         [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
            oMax = Application.Max(Dic(k).Item(p)(0), oMax)
            oMax2 = Application.Max(Dic(k).Item(p)(1), oMax2)
        [COLOR="Navy"]Next[/COLOR] p
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
                [COLOR="Navy"]If[/COLOR] Dic(k).Item(p)(0) = oMax [COLOR="Navy"]Then[/COLOR] Num1 = Num1 & IIf(Num1 = "", p, ", " & p)
        [COLOR="Navy"]Next[/COLOR] p
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
            [COLOR="Navy"]If[/COLOR] Dic(k).Item(p)(1) = oMax2 [COLOR="Navy"]Then[/COLOR] Num2 = Num2 & IIf(Num2 = "", p, ", " & p)
        [COLOR="Navy"]Next[/COLOR] p
            c = c + 1
            ray(c, 1) = k
            ray(c, 2) = Num1
            ray(c, 3) = Num2
            Num1 = "": Num2 = ""
   [COLOR="Navy"]Next[/COLOR] k


[COLOR="Navy"]With[/COLOR] Range("F1").Resize(c, 3)
  .Value = ray
  .Borders.Weight = 2
  .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 
Upvote 0
Superb, thank you very much!
You are very welcome. :)

If interested, the changes to my functions to list equal most visited or equal most successful would be

Code:
Function MostVisited(sName As String, rNames As Range, rlocations As Range) As String
  Dim d As Object, x
  Dim Maxnum As Long, i As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  sName = LCase(sName)
  For i = 1 To rNames.Rows.Count
    If LCase(rNames.Cells(i).Value) = sName Then d(rlocations.Cells(i).Value) = d(rlocations.Cells(i).Value) + 1
  Next i
  Maxnum = Application.Max(d.items)
  For i = 0 To d.Count - 1
    If d.items()(i) = Maxnum Then MostVisited = MostVisited & ", " & d.keys()(i)
  Next i
  MostVisited = Mid(MostVisited, 3)
End Function

Function MostSuccessful(sName As String, rNames As Range, rlocations As Range, rOutcomes As Range) As String
  Dim d As Object
  Dim c As Range
  Dim Maxnum As Long, i As Long
  
  Set d = CreateObject("Scripting.Dictionary")
  sName = LCase(sName)
  For i = 1 To rNames.Rows.Count
    If LCase(rNames.Cells(i).Value) = sName And LCase(rOutcomes.Cells(i).Value) = "w" Then d(rlocations.Cells(i).Value) = d(rlocations.Cells(i).Value) + 1
  Next i
  Maxnum = Application.Max(d.items)
  For i = 0 To d.Count - 1
    If d.items()(i) = Maxnum Then MostSuccessful = MostSuccessful & ", " & d.keys()(i)
  Next i
  MostSuccessful = Mid(MostSuccessful, 3)
End Function


Note that I have altered the original sample data slightly below.

Excel Workbook
ABCDEFG
1NameLocationOutcomeNameMost VisitedMost Successful
2KrisBarbadosWKrisLondonBirmingham, London
3JohnGlasgowLJohnGlasgow, Barbados, LondonLondon
4KrisBirminghamW
5JohnBarbadosL
6KrisBirminghamW
7KrisLondonL
8KrisLondonW
9KrisLondonW
10JohnLondonW
Most Common (List Equals)
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,972
Members
448,537
Latest member
Et_Cetera

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top