Trying to count how many times a player is in the same match of a golf league

[seandris08]

I run a 20 man golf league which consists of matches of 2v2 every week but we do it where every week your partner switches (all close friends). I have already created a schedule that balances tee times and has everyone playing with someone for weeks 1-19. the last thing I want to do is count how many times a player manages to be in the same match as another player to try and balance how many times a person sees the other person. for instance in my current set up player 2 and player 3 manage to be in the same match 8 of 19 weeks. What I am trying to do is create a chart off to the side that shows me how many times 1 plays with 2, 3,4,.. and so on. below is a screenshot of my table, the formula would have to count similarities in columns of 4 so it only counts instances in week 1 match 1 and so on. this will allow me to manually adjust if there are players that manage to play each other alot
my scheduling table.

 

[maabadi]

Try this code & See Your Results at two-side table with Column & Row Headers at Opponent No.
Result pasted at Range("A24:T44").
If you want see week no. and match no. for each match we should add some lines to code.

Sub CountComatches()
Dim i As Long, j As Long, k As Long, A As Long, B As Long, C As Long, D As Long, Arr(1 To 20, 1 To 20) As Variant
For j = 2 To 20
For k = 3 To 22 Step 4
A = Cells(k, j).Value
B = Cells(k + 1, j).Value
C = Cells(k + 2, j).Value
D = Cells(k + 3, j).Value
Arr(A, B) = Arr(A, B) + 1
Arr(A, C) = Arr(A, C) + 1
Arr(A, D) = Arr(A, D) + 1
Arr(B, C) = Arr(B, C) + 1
Arr(B, D) = Arr(B, D) + 1
Arr(C, D) = Arr(C, D) + 1
Next k
Next j
For A = 1 To 20
Cells(24, A + 1).Value = A
Cells(A + 24, 1).Value = A
For B = A To 20
If A < B Then
Arr(A, B) = Arr(A, B) + Arr(B, A)
End If
Arr(B, A) = Arr(A, B)
Next B
Next A
Range("A24") = "Opponent No."
Range("B25").Resize(20, 20).Value = Arr
End Sub