Incl. tie management.
Sub test()
Dim a, i As Long, e, n As Long, x As Object
With CreateObject("System.Collections.SortedList")
For Each e In [{"Sheet 1","Sheet 2","Sheet 3"}]
a = Sheets(e).Cells(1).CurrentRegion.Value
For i = 2 To UBound(a, 1)
If Not .Contains(a(i, 14)) Then
Set .Item(a(i, 14)) = CreateObject("System.Collections.ArrayList")
End If
If Not .Item(a(i, 14)).Contains(a(i, 1)) Then .Item(a(i, 14)).Add a(i, 1)
Next
Next
Set x = .Clone
End With
With Sheets.Add.Cells(1).Resize(, 3)
.Value = [{"Rank","Name","Score"}]
For i = x.Count - 1 To 0 Step -1
n = n + 1
If n > 20 Then Exit For
With .Cells(n + 1, 1).Resize(x.GetByIndex(i).Count)
.Columns(1).Value = n
.Columns(2).Value = Application.Transpose(x.GetByIndex(i).ToArray)
.Columns(3).Value = x.GetKey(i)
End With
n = n + x.GetByIndex(i).Count - 1
Next
End With
End Sub
Bookmarks