Most Occurring Text Multiple Criteria

K

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:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Location[/TD]
[TD]Outcome[/TD]
[/TR]
[TR]
[TD]Kris[/TD]
[TD]Barbados[/TD]
[TD]W[/TD]
[/TR]
[TR]
[TD]John[/TD]
[TD]Glasgow[/TD]
[TD]L[/TD]
[/TR]
[TR]
[TD]Kris[/TD]
[TD]Birmingham[/TD]
[TD]W[/TD]
[/TR]
[TR]
[TD]John[/TD]
[TD]Barbados[/TD]
[TD]L[/TD]
[/TR]
[TR]
[TD]Kris[/TD]
[TD]Birmingham[/TD]
[TD]W[/TD]
[/TR]
[TR]
[TD]Kris[/TD]
[TD]London[/TD]
[TD]L[/TD]
[/TR]
[TR]
[TD]Kris[/TD]
[TD]London[/TD]
[TD]W[/TD]
[/TR]
[TR]
[TD]Kris[/TD]
[TD]London[/TD]
[TD]L[/TD]
[/TR]
[TR]
[TD]John[/TD]
[TD]London[/TD]
[TD]W[/TD]
[/TR]
</tbody>[/TABLE]


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).

[TABLE="width: 500"]
<tbody>[TR]
[TD]Name[/TD]
[TD]Most Visited[/TD]
[TD]Most Successful[/TD]
[/TR]
[TR]
[TD]Kris[/TD]
[TD]London[/TD]
[TD]Birmingham[/TD]
[/TR]
[TR]
[TD]John[/TD]
[TD]-[/TD]
[TD]London[/TD]
[/TR]
</tbody>[/TABLE]
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Sort by date Sort by votes
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
Kris_ said:
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.
Click to expand...
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
Kris_ said:
Superb, thank you very much!
Click to expand...
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
You must log in or register to reply here.

Similar threads

B
  • Question Question
Reference UK Post Code Column to Create and print Country from a reference table? IF formula or VLookup?
Replies
5
Views
653
Fluff
Fluff
J
  • Question Question
Create a TEXT String based on numbers in a spreadsheet
Replies
9
Views
791
AlanY
A
G
  • Question Question
Allocating Mentors to Students based on criteria
Replies
1
Views
1K
Peter_SSs
Peter_SSs
D
  • Question Question
Using Multiple Criteria in Index Match Array formula
Replies
6
Views
1K
Fluff
Fluff
S
  • Question Question
Multiple Criteria Sorting
Replies
1
Views
571
Rijnsent
Rijnsent

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

Share this page

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