Need Help making a tournament sheet

[CBL]

Hi,

So we have an ongoing league and on game night players are assigned to pods of 4.
Initially, we manually assigned players to their first pod of the night.

Then they would score 3 points for win
1 point for second


Can someone point me in what I need to look up to have

A list of players with their current score (from previous nights)
and then have the sheet (based on their score) assign those into 'pods'
with 4 people per pod.

 

[VincentNL99]

Is the win for a pod or person?

 

[CBL]

Is the win for a pod or person?

Oh yeah, sorry.

So the win is for 1 person in each pod

 

[VincentNL99]

Create two sheets. Sheet "Players" and sheet "Poule"

Sheet players should look like this:

tournament.xlsm
	A	B
1	PlayerName	PlayerScore
2	b	0
3	f	0
4	j	0
5	n	0
6	a	0
7	i	0
8	m	0
9	d	0
10	k	0
11	g	0
12	e	0
13	c	0
14	l	0
15	h	0
16	o	0
17	p	0
Players

Create a button and assign following macro to it:

Sub CreatePoule()
Dim PlayerNames As Range
Dim PlayerScore As Range
Dim PlayersWorkSheet As Worksheet
Dim ranking As Integer
Dim rankedrow As Double
Dim rng As Range
Dim ranked As Variant


Set WS = Worksheets("Players")

For ranking = 1 To 16
Worksheets("Poule").Cells(ranking, 1) = ranking
Next ranking

Range("a2:b17").Copy Destination:=Worksheets("poule").Range("b1")

Worksheets("poule").Sort.SortFields.Clear
Worksheets("Poule").Sort.SortFields.Add2 Key:=Range("C1:c16" _
        ), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With Worksheets("poule").Sort
        .SetRange Range("b1:c16")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


Worksheets("poule").Select
Sheets("Poule").Range("$A$1").EntireRow.Insert
Range("a1") = "Ranking"
Range("b1") = "Player Name"
Range("c1") = "Points"
Range("d1") = "Result"





Sheets("Poule").Range("$A$6").EntireRow.Insert
Sheets("Poule").Range("$A$11").EntireRow.Insert
Sheets("Poule").Range("$A$16").EntireRow.Insert
Range("a21:d30").ClearContents
Range("d2:d30").ClearContents
Range("f4:f5").ClearContents
Range("f3") = "Enter 1 or 2 for every poule in column D"
Range("a1").Select


End Sub

Create a button in sheet poule and assign following macro to it:

Sub EnteringResult()

For enterresult = 1 To 20
If Cells(enterresult, 4) = 1 Then
Cells(enterresult, 3) = Cells(enterresult, 3) + 3
End If
If Cells(enterresult, 4) = 2 Then
Cells(enterresult, 3) = Cells(enterresult, 3).Value + 1
End If



Next enterresult

Range("b2:c20").Copy Destination:=Worksheets("Players").Range("a2")
Worksheets("players").Activate
Rows("6:6").Delete Shift:=xlUp
Rows("10:10").Delete Shift:=xlUp
Rows("14:14").Delete Shift:=xlUp


End Sub