For the following image:

I have the list of unique players in our quiz nights. I need a way to select and show the best player across all games we play. Each game is on its own separate table. We have only had 2 quiz nights so far but would like to do more so it needs to be dynamic.

I need a function to select the best player on any of the teams (they can play on different teams each game) who plays in the highest-scoring team. So a function that selects all the headers, and compares against the unique list of players, and then finds the player who has played on both/all the highest scoring/winning teams for all games that we have played, and will play. And needs to be able to add a new table to index each time a new game is played.

Also, each time we play, there can be more or less teams playing.

CodePudding user response：

if I understand your question you need to detect which column name has the largest value in the last row so first you need a new row you may hide contain the sum of ones above without "/16" and in the cell use (index & match & max)

=INDEX("range of players"; MATCH( MAX("range of scores"); "range of scores" ; 0))

you could use "," instead of ";" according to your office numbers and date settings

CodePudding user response：

Use another sheet to collate the results and sort to find the best.

Option Explicit
Sub LeagueTable()

   Dim wb As Workbook, ws As Worksheet, tbl As ListObject
   Dim r As Long, c As Long, data As Range
   Dim team As String, score As Single, qcount As Long

   Set wb = ThisWorkbook
   Set ws = wb.Sheets("Sheet1") ' score sheet

   Dim dict As Object, key, ar
   Set dict = CreateObject("Scripting.Dictionary")

   ' scan each table
   For Each tbl In ws.ListObjects
       Set data = tbl.DataBodyRange
       For c = 1 To tbl.HeaderRowRange.Columns.Count
           ' team from header row
           team = tbl.HeaderRowRange.Cells(1, c)
           qcount = tbl.DataBodyRange.Rows.Count
           score = WorksheetFunction.Sum(data.Cells(1, c).Resize(qcount))

           ' update team members performance
           For Each key In Split(team, ",")
               key = Trim(key) ' team members name
               
               If dict.exists(key) Then
                    ar = dict(key)
                    ar(0) = ar(0)   score
                    ar(1) = ar(1)   qcount
                    ar(2) = ar(2)   1 ' number of quizes
                    dict(key) = ar
               Else
                    dict.Add key, Array(score, qcount, 1)
               End If
           Next
       Next
    Next

   ' dump results to another sheet
    Set ws = Sheet2 'wb.sheets("Player Scores")
    With ws
        .Cells.Clear
        .Range("A1:E1") = Array("Player", "Score", "Count", "Avg %", "Quiz Count")
        .Range("D:D").NumberFormat = "0%"
        r = 1
        For Each key In dict
            r = r   1
            ar = dict(key)
            .Cells(r, 1) = key
            .Cells(r, 2) = ar(0)
            .Cells(r, 3) = ar(1)
            .Cells(r, 4).FormulaR1C1 = "=RC[-2]/RC[-1]"
            .Cells(r, 5) = ar(2)
        Next
    End With
    ' sort table
    With ws.Sort
        .SortFields.Clear
        .SortFields.Add ws.Range("D1"), SortOn:=xlSortOnValues, _
                Order:=xlDescending, DataOption:=xlSortNormal
        .SetRange ws.Range("A1:E" & r)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    ws.Activate
    ws.Range("A1").Select
    MsgBox "Done"
End Sub