Edit VBA to count ties.

[emperorgenghiskhan]

I would like to have the VBA be able to generate a Tie/Draw column for instances where the score is tied.
Thanks in advance

The code used in the VBA was what was posted by Peter_SSs in this thread

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