Results 1 to 10 of 10

Thread: Most Occurring Text Multiple Criteria

  1. #1
    New Member
    Join Date
    Aug 2019
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Most Occurring Text Multiple Criteria

    Hoping there is someone out there, with a genius mind in VBA or excel formulas.

    I data set:

    Name Location Outcome
    Kris Barbados W
    John Glasgow L
    Kris Birmingham W
    John Barbados L
    Kris Birmingham W
    Kris London L
    Kris London W
    Kris London L
    John London W


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

    Name Most Visited Most Successful
    Kris London Birmingham
    John - London

  2. #2
    Board Regular
    Join Date
    Dec 2018
    Location
    Poland
    Posts
    203
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Most Occurring Text Multiple Criteria

    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

  3. #3
    MrExcel MVP
    Moderator
    Peter_SSs's Avatar
    Join Date
    May 2005
    Location
    Macksville, Australia
    Posts
    40,976
    Post Thanks / Like
    Mentioned
    90 Post(s)
    Tagged
    21 Thread(s)

    Default Re: Most Occurring Text Multiple Criteria

    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.
    Last edited by Peter_SSs; Aug 9th, 2019 at 09:47 AM.
    Hope this helps, good luck.
    Peter
    Excel 365 - Windows 10
    - Want to help your helpers by posting a small, copyable, screen shot directly in your post? Look here
    - If posting vba code, please use Code Tags - like this [code]Paste code here[/code] - or use the # key in the Reply window
    - Read: Forum Rules, Forum Use Guidelines, & FAQ

  4. #4
    New Member
    Join Date
    Aug 2019
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Most Occurring Text Multiple Criteria

    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.

  5. #5
    MrExcel MVP
    Join Date
    Jan 2008
    Posts
    14,837
    Post Thanks / Like
    Mentioned
    26 Post(s)
    Tagged
    12 Thread(s)

    Default Re: Most Occurring Text Multiple Criteria

    This may be a result that you can use/Or you can live with.
    Result start "F1".

    Code:
    Sub MG09Aug27
    im Dn As Range, Rng As Range, Dic As Object, Q As Variant
    Dim nSum As Long, k As Variant
    Dim p As Variant, c As Long
    
    Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
     Set Dic = CreateObject("Scripting.Dictionary")
        Dic.CompareMode = 1
       For Each Dn In Rng
                If Not Dic.exists(Dn.Value) Then
                    Set Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
                End If
            
            If Not Dic(Dn.Value).exists(Dn.Offset(, 1).Value) Then
                   If Dn.Offset(, 2) = "W" Then nSum = 1
                    Dic(Dn.Value).Add (Dn.Offset(, 1).Value), Array(nSum, 1)
            Else
                    Q = Dic(Dn.Value).Item(Dn.Offset(, 1).Value)
                        If Dn.Offset(, 2) = "W" Then Q(0) = Q(0) + 1
                        Q(1) = Q(1) + 1
                    Dic(Dn.Value).Item(Dn.Offset(, 1).Value) = Q
            End If
        Next 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"
    
        For Each k In Dic.Keys
             For Each p In 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)
              Next p
       
        Next k
    With Range("F1").Resize(c, 4)
      .Value = ray
      .Borders.Weight = 2
      .Columns.AutoFit
    End With
    End Sub
    Regards Mick

  6. #6
    New Member
    Join Date
    Aug 2019
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Most Occurring Text Multiple Criteria

    @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".

  7. #7
    MrExcel MVP
    Moderator
    Peter_SSs's Avatar
    Join Date
    May 2005
    Location
    Macksville, Australia
    Posts
    40,976
    Post Thanks / Like
    Mentioned
    90 Post(s)
    Tagged
    21 Thread(s)

    Default Re: Most Occurring Text Multiple Criteria

    Quote Originally Posted by Kris_ View Post
    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
    Most Common

    ABCDEFG
    1NameLocationOutcome NameMost VisitedMost Successful
    2KrisBarbadosW KrisLondonBirmingham
    3JohnGlasgowL JohnGlasgowLondon
    4KrisBirminghamW
    5JohnBarbadosL
    6KrisBirminghamW
    7KrisLondonL
    8KrisLondonW
    9KrisLondonL
    10JohnLondonW

    Spreadsheet Formulas
    CellFormula
    F2=MostVisited(E2,A$2:A$10,B$2:B$10)
    G2=MostSuccessful(E2,A$2:A$10,B$2:B$10,C$2:C$10)


    Excel tables to the web >> Excel Jeanie HTML 4
    Hope this helps, good luck.
    Peter
    Excel 365 - Windows 10
    - Want to help your helpers by posting a small, copyable, screen shot directly in your post? Look here
    - If posting vba code, please use Code Tags - like this [code]Paste code here[/code] - or use the # key in the Reply window
    - Read: Forum Rules, Forum Use Guidelines, & FAQ

  8. #8
    New Member
    Join Date
    Aug 2019
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Most Occurring Text Multiple Criteria

    Superb, thank you very much!

  9. #9
    MrExcel MVP
    Join Date
    Jan 2008
    Posts
    14,837
    Post Thanks / Like
    Mentioned
    26 Post(s)
    Tagged
    12 Thread(s)

    Default Re: Most Occurring Text Multiple Criteria

    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:
    Sub MG09Aug27
    Dim Dn As Range, Rng As Range, Dic As Object, Q As Variant
    Dim nSum As Long, k As Variant
    Dim p As Variant, c As Long
    Dim oMax As Long, oMax2 As Long, Num1 As String, Num2 As String
    
    Set Rng = Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
     Set Dic = CreateObject("Scripting.Dictionary")
        Dic.CompareMode = 1
       For Each Dn In Rng
                nSum = 0
                If Not Dic.exists(Dn.Value) Then
                    Set Dic(Dn.Value) = CreateObject("Scripting.Dictionary")
                End If
            
            If Not Dic(Dn.Value).exists(Dn.Offset(, 1).Value) Then
                   If Dn.Offset(, 2) = "W" Then nSum = 1
                    Dic(Dn.Value).Add (Dn.Offset(, 1).Value), Array(1, nSum)
            Else
                    Q = Dic(Dn.Value).Item(Dn.Offset(, 1).Value)
                        If Dn.Offset(, 2) = "W" Then Q(1) = Q(1) + 1
                        Q(0) = Q(0) + 1
                    Dic(Dn.Value).Item(Dn.Offset(, 1).Value) = Q
            End If
        Next 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"
        For Each k In Dic.Keys
             oMax = 0: oMax2 = 0
             For Each p In Dic(k)
                oMax = Application.Max(Dic(k).Item(p)(0), oMax)
                oMax2 = Application.Max(Dic(k).Item(p)(1), oMax2)
            Next p
            For Each p In Dic(k)
                    If Dic(k).Item(p)(0) = oMax Then Num1 = Num1 & IIf(Num1 = "", p, ", " & p)
            Next p
            For Each p In Dic(k)
                If Dic(k).Item(p)(1) = oMax2 Then Num2 = Num2 & IIf(Num2 = "", p, ", " & p)
            Next p
                c = c + 1
                ray(c, 1) = k
                ray(c, 2) = Num1
                ray(c, 3) = Num2
                Num1 = "": Num2 = ""
       Next k
    
    
    With Range("F1").Resize(c, 3)
      .Value = ray
      .Borders.Weight = 2
      .Columns.AutoFit
    End With
    End Sub
    Regards Mick

  10. #10
    MrExcel MVP
    Moderator
    Peter_SSs's Avatar
    Join Date
    May 2005
    Location
    Macksville, Australia
    Posts
    40,976
    Post Thanks / Like
    Mentioned
    90 Post(s)
    Tagged
    21 Thread(s)

    Default Re: Most Occurring Text Multiple Criteria

    Quote Originally Posted by Kris_ View Post
    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.

    Most Common (List Equals)

    ABCDEFG
    1NameLocationOutcome NameMost VisitedMost Successful
    2KrisBarbadosW KrisLondonBirmingham, London
    3JohnGlasgowL JohnGlasgow, Barbados, LondonLondon
    4KrisBirminghamW
    5JohnBarbadosL
    6KrisBirminghamW
    7KrisLondonL
    8KrisLondonW
    9KrisLondonW
    10JohnLondonW

    Spreadsheet Formulas
    CellFormula
    F2=MostVisited(E2,A$2:A$10,B$2:B$10)
    G2=MostSuccessful(E2,A$2:A$10,B$2:B$10,C$2:C$10)


    Excel tables to the web >> Excel Jeanie HTML 4
    Hope this helps, good luck.
    Peter
    Excel 365 - Windows 10
    - Want to help your helpers by posting a small, copyable, screen shot directly in your post? Look here
    - If posting vba code, please use Code Tags - like this [code]Paste code here[/code] - or use the # key in the Reply window
    - Read: Forum Rules, Forum Use Guidelines, & FAQ

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •