Listing of "Formula 1" Racing Teams

Sub F1Fantasy()
Dim a, b(), i As Long, j As Long, k As Long, TeamTotal, DriverTotal, n As Long
Dim TeamList As Object, DriverList As Object
Dim ws As Worksheet
Set TeamList = CreateObject("System.Collections.ArrayList")
Set DriverList = CreateObject("System.Collections.ArrayList")
a = Sheets("Team and Drivers").Cells(1).CurrentRegion.Value
For i = 2 To UBound(a, 1)
    For j = i + 1 To UBound(a, 1)
        For k = j + 1 To UBound(a, 1)
            TeamList.Add (Array(a(i, 1), a(j, 1), a(k, 1), a(i, 2) + a(j, 2) + a(k, 2)))
        Next
    Next
Next
a = Sheets("Team and Drivers").Cells(16, 1).CurrentRegion.Value
For i = 2 To UBound(a, 1)
    For j = i + 1 To UBound(a, 1)
        For k = j + 1 To UBound(a, 1)
            DriverList.Add (Array(a(i, 1), a(j, 1), a(k, 1), a(i, 2) + a(j, 2) + a(k, 2)))
        Next
    Next
Next
ReDim b(1 To 200000, 1 To 7)
For i = 0 To TeamList.Count - 1
    TeamTotal = TeamList(i)
    For j = 0 To DriverList.Count - 1
        DriverTotal = DriverList(j)
        If TeamTotal(3) + DriverTotal(3) < 76 Then
            n = n + 1
            For k = 1 To 3
                b(n, k) = DriverTotal(k - 1): b(n, k + 3) = TeamTotal(k - 1)
            Next
            b(n, 7) = DriverTotal(3) + TeamTotal(3)
        End If
    Next
Next
Set ws = Worksheets.Add
ws.Range("a1").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub