Track Match-Ups and winners for sport based competition

[emperorgenghiskhan]

I am trying to help a friend who wants to track win-loss against individual opponents and if possible further break that down by what location the game was played at. Final scores are not an issue as it is a win/lose game.
After a few days searching I found this this thread. And used it as a template. I would like to put the winner/loser name in the score columns and use that to count and if possible add a location column and have a win/loss record by location played. For example column E could be Location, but this is not essential at all. And last if at all possible move the bottom chart (where the results per opponent are) to thier own columns instead of under the cumulative records.
Any help will be very welcome.

The code used in the VBA was what was posted by Peter_SSs in the thread I linked before

Sub ResultSummary_v2()
  Dim d1 As Object, d2 As Object
  Dim a As Variant, ky As Variant
  Dim sPlayers As String, tmp As String, P1 As String
  Dim i As Long, j As Long, winner As Long, nr As Long
 
  Set d1 = CreateObject("Scripting.Dictionary")
  d1.CompareMode = 1
  Set d2 = CreateObject("Scripting.Dictionary")
  d2.CompareMode = 1
  a = Range("A2", Range("D" & Rows.Count).End(xlUp)).Value
  For i = 1 To UBound(a)
    If Len(a(i, 1)) * Len(a(i, 2)) > 0 Then
      If a(i, 1) > a(i, 2) Then
        tmp = a(i, 1)
        a(i, 1) = a(i, 2)
        a(i, 2) = tmp
        tmp = a(i, 3)
        a(i, 3) = a(i, 4)
        a(i, 4) = tmp
      End If
      winner = IIf(a(i, 3) > 0, 1, 2)
      For j = 1 To 2
        If d2.exists(a(i, j)) Then
          d2(a(i, j)) = Split(d2(a(i, j)), ";")(0) + 1 & ";" & Split(d2(a(i, j)), ";")(1) + IIf(winner = j, 1, 0)
        Else
          d2(a(i, j)) = "1;" & IIf(winner = j, 1, 0)
        End If
      Next j
      sPlayers = a(i, 1) & ";" & a(i, 2)
      If d1.exists(sPlayers) Then
        If winner = 1 Then
          d1(sPlayers) = ";;" & Split(d1(sPlayers), ";")(2) + 1 & ";;" & Split(d1(sPlayers), ";")(4)
        Else
          d1(sPlayers) = ";;" & Split(d1(sPlayers), ";")(2) & ";;" & Split(d1(sPlayers), ";")(4) + 1
        End If
      Else
        d1(sPlayers) = IIf(winner = 1, ";;1;;0", ";;0;;1")
      End If
    End If
  Next i
  Application.ScreenUpdating = False
  Columns("I:P").Clear
  With Range("I2:J2").Resize(d2.Count)
    .Rows(0).Resize(, 6).Value = Array("Player", "Played", "Won", "Lost", "% Won", "Rank")
    .Rows(0).Resize(, 6).Font.Bold = True
    .Value = Application.Transpose(Array(d2.keys, d2.Items))
    .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlNo
    .Columns(2).TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False
    .Offset(, 3).Resize(, 1).FormulaR1C1 = "=RC[-2]-RC[-1]"
    .Offset(, 4).Resize(, 1).FormulaR1C1 = "=RC[-2]/RC[-3]"
    .Offset(, 4).Resize(, 1).NumberFormat = "0.00%"
    .Offset(, 5).Resize(, 1).FormulaR1C1 = "=RANK(RC[-1],R" & .Row & "C[-1]:R" & .Row + .Rows.Count - 1 & "C[-1])"
    a = .Columns(1).Value
  End With
  nr = UBound(a) + 4
  Range("I" & nr - 1).Resize(, 7).Value = Array("Player", "", "Opponent", "Played", "Won", "Lost", "% Won")
  Range("I" & nr - 1).Resize(, 7).Font.Bold = True
  For i = 1 To UBound(a)
    d2.RemoveAll
    P1 = a(i, 1)
    For Each ky In d1.keys
      Select Case True
        Case Split(ky, ";")(0) = P1
          d2(Split(ky, ";")(1)) = Mid(d1(ky), 2)
        Case Split(ky, ";")(1) = P1
          d2(Split(ky, ";")(0)) = ";" & Split(d1(ky), ";")(4) & ";" & Split(d1(ky), ";")(2)
      End Select
    Next ky
    With Range("K" & nr & ":L" & nr).Resize(d2.Count)
      .Cells(1, -1).Resize(, 2).Value = Array(P1, "v")
      .Value = Application.Transpose(Array(d2.keys, d2.Items))
      .Sort Key1:=.Columns(1), Order1:=xlAscending, Header:=xlNo
      .Columns(2).TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=True, Semicolon:=True, Comma:=False, Space:=False, Other:=False
      .Offset(, 1).Resize(, 1).FormulaR1C1 = "=RC[1]+RC[2]"
      With .Offset(, 4).Resize(, 1)
        .NumberFormat = "0.00%"
        .FormulaR1C1 = "=RC[-2]/RC[-3]"
      End With
      nr = nr + d2.Count + 1
    End With
  Next i
  Columns("I:O").AutoFit
  Application.ScreenUpdating = True
End Sub

One On One.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	Player 1	Player 2	Winner	Loser					Player	Played	Won	Lost	% Won	Rank
2									Darryl Strawberry	2	1	1	50.00%	5
3	Tom Seaver	Dwight Gooden	0	13					Dwight Gooden	5	3	2	60.00%	4
4	Dwight Gooden	Tom Seaver	2	0					Gary Carter	2	2	0	100.00%	1
5	Darryl Strawberry	Nolan Ryan	87	0					John Olerud	6	4	2	66.67%	2
6	Nolan Ryan	Tom Seaver	0	28					Keith Hernandez	3	1	2	33.33%	8
7	Gary Carter	Nolan Ryan	59	0					Lenny Dykstra	3	1	2	33.33%	8
8	Keith Hernandez	Dwight Gooden	0	16					Mike Piazza	4	2	2	50.00%	5
9	Lenny Dykstra	Tom Seaver	41	0					Nolan Ryan	5	2	3	40.00%	7
10	Mike Piazza	Roberto Alomar	133	0					Roberto Alomar	3	2	1	66.67%	2
11	Roberto Alomar	Mike Piazza	34	0					Tom Seaver	7	2	5	28.57%	10
12	John Olerud	Lenny Dykstra	40	0
13	Tom Seaver	John Olerud	0	129					Player		Opponent	Played	Won	Lost	% Won
14	Darryl Strawberry	Nolan Ryan	0	70					Darryl Strawberry	v	Nolan Ryan	2	1	1	50.00%
15	Gary Carter	John Olerud	27	0
16	Lenny Dykstra	John Olerud	0	13					Dwight Gooden	v	Keith Hernandez	2	1	1	50.00%
17	Roberto Alomar	Mike Piazza	6	0							Tom Seaver	3	2	1	66.67%
18	John Olerud	Keith Hernandez	38	0
19	Mike Piazza	John Olerud	2	0					Gary Carter	v	John Olerud	1	1	0	100.00%
20	Keith Hernandez	Dwight Gooden	94	0							Nolan Ryan	1	1	0	100.00%
21	Nolan Ryan	Tom Seaver	16	0
22	Dwight Gooden	Tom Seaver	0	18					John Olerud	v	Gary Carter	1	0	1	0.00%
23											Keith Hernandez	1	1	0	100.00%
24											Lenny Dykstra	2	2	0	100.00%
25											Mike Piazza	1	0	1	0.00%
26											Tom Seaver	1	1	0	100.00%
27
28									Keith Hernandez	v	Dwight Gooden	2	1	1	50.00%
29											John Olerud	1	0	1	0.00%
30
31									Lenny Dykstra	v	John Olerud	2	0	2	0.00%
32											Tom Seaver	1	1	0	100.00%
33
34									Mike Piazza	v	John Olerud	1	1	0	100.00%
35											Roberto Alomar	3	1	2	33.33%
36
37									Nolan Ryan	v	Darryl Strawberry	2	1	1	50.00%
38											Gary Carter	1	0	1	0.00%
39											Tom Seaver	2	1	1	50.00%
40
41									Roberto Alomar	v	Mike Piazza	3	2	1	66.67%
42
43									Tom Seaver	v	Dwight Gooden	3	1	2	33.33%
44											John Olerud	1	0	1	0.00%
45											Lenny Dykstra	1	0	1	0.00%
46											Nolan Ryan	2	1	1	50.00%
Sheet1

Cell Formulas
Range	Formula
L2:L11	L2	=J2-K2
O43:O46,O41,O37:O39,O34:O35,O31:O32,O28:O29,O22:O26,O19:O20,O16:O17,O14,M2:M11	M2	=K2/J2
N2:N11	N2	=RANK(M2,M$2:M$11)
L14,L43:L46,L41,L37:L39,L34:L35,L31:L32,L28:L29,L22:L26,L19:L20,L16:L17	L14	=M14+N14

 

[emperorgenghiskhan]

Data is not yet in any format as he has it all in handwritten notes. So formatting can be totally changed if need be.