Public Sub ResultsTable()
Dim wsResults As Worksheet
Dim lastrow As Long
Dim nextrow As Long
Dim nextcol As Long
Dim matchrow As Long
Dim matchcol As Long
Dim i As Long
Application.DisplayAlerts = False
On Error Resume Next
Worksheets("Results Table").Delete
On Error GoTo 0
Application.DisplayAlerts = True
With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set wsResults = Worksheets.Add(after:=Worksheets(Worksheets.Count))
wsResults.Name = "Results Table"
nextrow = 2: nextcol = 2
For i = 2 To lastrow
If IsError(Application.Match(.Cells(i, "B").Value, wsResults.Columns(1), 0)) Then
wsResults.Cells(nextrow, "A").Value = .Cells(i, "B").Value
nextrow = nextrow + 1
End If
If IsError(Application.Match(.Cells(i, "D").Value, wsResults.Columns(1), 0)) Then
wsResults.Cells(nextrow, "A").Value = .Cells(i, "D").Value
nextrow = nextrow + 1
End If
If IsError(Application.Match(.Cells(i, "B").Value, wsResults.Rows(1), 0)) Then
wsResults.Cells(1, nextcol).Value = .Cells(i, "B").Value
nextcol = nextcol + 1
End If
If IsError(Application.Match(.Cells(i, "D").Value, wsResults.Rows(1), 0)) Then
wsResults.Cells(1, nextcol).Value = .Cells(i, "D").Value
nextcol = nextcol + 1
End If
Next i
For i = 2 To lastrow
matchrow = Application.Match(.Cells(i, "B").Value, wsResults.Columns(1), 0)
matchcol = Application.Match(.Cells(i, "D").Value, wsResults.Rows(1), 0)
wsResults.Cells(matchrow, matchcol).Value = .Cells(i, "E").Value
matchrow = Application.Match(.Cells(i, "D").Value, wsResults.Columns(1), 0)
matchcol = Application.Match(.Cells(i, "B").Value, wsResults.Rows(1), 0)
wsResults.Cells(matchrow, matchcol).Value = .Cells(i, "F").Value
Next i
End With
With wsResults
.Cells(2, nextcol).Resize(nextrow - 2).FormulaR1C1 = "=SUM(RC2:RC[-1])"
.Cells(2, nextcol + 1).FormulaR1C1 = "=INDEX(R2C1:R" & nextrow & "C1,MATCH(MAX(R2C5:R" & nextrow & "C5),R2C5:R" & nextrow & "C5,0))"
.Cells(2, nextcol + 2).FormulaR1C1 = "=INDEX(R2C1:R" & nextrow & "C1,MATCH(LARGE(R2C5:R" & nextrow & "C5,2),R2C5:R" & nextrow & "C5,0))"
.Cells(1, nextcol).Resize(, 3).Value = Array("Cumulative Score", "Winners", "Runners-Up")
.Columns(1).Resize(, nextcol + 2).ColumnWidth = 16
End With
End Sub