Competition Draw Grids

  BigAl127 09:09 28 Apr 04
Locked

Does anyone know of a program that allows you to insert the entrants names into a competition (max 64 Entrants) and then sorts out a draw grid with byes if possible. If need be, the draw could be done manually, and the names written in.

The part I really need is the grid, starting with 64 entrants(32 singles matches) winners thru to next round (32 winners, 16 matches) right down to the final 2 with space for the winners name at the end.

Thanks in advance.

  Graham ® 09:19 28 Apr 04

Do you have Excel?

  Taff36 11:32 28 Apr 04

I presume this is a tennis knockout but I`ve something similar in Word. It is a table set up in a document with 32 names on each of two pages reducing to the final. You should be able to type in the first 64 Entrants the result and then copy and paste the winner forward to the next round.

Send me an e-mail if you want a copy that you can adapt to suit yourself.

  BigAl127 17:32 28 Apr 04

Graham ®

Yes, I have excel. I have done a manual layout, but preferred a program that would allow me to enter the number of entrants (max 64) , and then, draw the grid with the number of byes. i.e. 29 entrants, would give 13 matches plus 3 byes, to give 16 matches next round.

  Graham ® 17:39 28 Apr 04

Then you need VoG tm!

  BigAl127 08:06 29 Apr 04

Bump

This will take a while to produce but two questions first.
1. What are the minimum and maximum contestants?
2. What version of excel do you have?

  BigAl127 22:29 29 Apr 04

Minimum 3 contestants ( although hopefully it'll never be that low) and Maximum 64 entrants. I have Excel 2000

The following code placed in a standard module will produce an automatic competition grid for between 3 and 64 competitors.

The worksheet has a deep row 1 for the competition header placed in cell C1. A1:G65 is the active area.

There are two buttons to Start which calls Contestants and Clear which calls ClearSheet.

Should anyone want the worksheet then it is only 25kb or 10kb in zip format, feel free to contact me by the envelope.

'--------------------------------------------

Option Explicit

Public Matches As Integer, Comps As Byte, ByeMatch As Byte, Byes As Boolean, iCol As String

Public iCnt As Integer, iRnd As Byte, iEnd As Byte, iRow As Integer, jRow As Integer

'--------------------------------------------

Sub Contestants()

Comps = InputBox("Enter the number of contestants")

If Comps < 3 Or Comps > 64 Then

MsgBox ("Number of contestants is" & Chr(13) & "limited to between 3 and 64")
Call Contestants

End If

Call Rounds(Comps)

End Sub

'--------------------------------------------

Sub ClearSheet()

Range("A2:G65").Select

Range("A2").Activate

Selection.ClearContents

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

Selection.Borders(xlEdgeLeft).LineStyle = xlNone

Selection.Borders(xlEdgeTop).LineStyle = xlNone

Selection.Borders(xlEdgeBottom).LineStyle = xlNone

Selection.Borders(xlEdgeRight).LineStyle = xlNone

Selection.Borders(xlInsideVertical).LineStyle = xlNone

Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

Selection.Interior.ColorIndex = xlNone

Application.Goto Reference:="R1C1"

End Sub


'--------------------------------------------

Sub NumberOfMatches(C)

'This routine dtermines how many Byes are needed in the first round

Dim FirstRound As Integer


Select Case C

Case 3, 4: FirstRound = 4

Case 5 To 8: FirstRound = 8

Case 9 To 16: FirstRound = 16

Case 17 To 32: FirstRound = 32

Case 33 To 64: FirstRound = 64

End Select

ByeMatch = FirstRound - C

Byes = ByeMatch <> 0

Matches = (C - ByeMatch) / 2

End Sub

'--------------------------------------------

Sub Rounds(C As Byte)

iRnd = 1

iCol = "A"

Call NumberOfMatches(C)

Application.ScreenUpdating = False

Do Until Matches < 1 And ByeMatch = 0

Select Case iRnd

Case 1: iRow = 2: jRow = 2: iCol = "A"

Case 2: iRow = 3: jRow = 4: iCol = "B": ByeMatch = 0

Case 3: iRow = 5: jRow = 8: iCol = "C"

Case 4: iRow = 9: jRow = 16: iCol = "D"

Case 5: iRow = 17: jRow = 32: iCol = "E"

Case 6: iRow = 33: jRow = 64: iCol = "F"

End Select

Call NextRound

Matches = (Matches + ByeMatch) / 2

iRnd = iRnd + 1

Loop

Cells(3, 6) = "Winner"

Cells(3, 7).Select

Call PutBorders(False)

Range("A1").Select

Application.ScreenUpdating = True

End Sub

'--------------------------------------------

Sub NextRound()

Dim Gap As Byte, ModResult As Byte


iEnd = iRow

Do Until iRow = iEnd + (Matches * jRow)

Range(Cells(iRow, iCol), Cells(iRow + 1, iCol)).Select

Call PutBorders(True)

iRow = iRow + jRow

Loop

If Byes Then

If ByeMatch = 2 Then

iRow = iRow + 1

Gap = 0

ElseIf (ByeMatch Mod 2) = 0 Then

iRow = iRow + 1

Gap = 2

ModResult = 0

ElseIf ByeMatch > 1 Then

Gap = 2

ModResult = 1

End If

For iCnt = 0 To ByeMatch - 1

If iCnt > 0 And iCnt Mod 2 = ModResult Then iRow = iRow + Gap

Cells(iRow + iCnt, iCol) = "Bye"

Next iCnt

Byes = False

End If

End Sub

'--------------------------------------------

Sub PutBorders(B As Boolean)

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

If B Then

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlContinuous

.Weight = xlHairline

.ColorIndex = xlAutomatic

End With

End If

With Selection.Interior

.ColorIndex = 19

.Pattern = xlSolid

.PatternColorIndex = xlAutomatic

End With

End Sub

'--------------------------------------------

  BigAl127 22:34 30 Apr 04

Many thanks to Whisperer for all his time and effort in producing a satisfactory solution for me. I am well impressed with the finished result.

Gordon - I have e-mailed you personally with my thanks, but thought the least I could do is to thank you publicly via the forum as well.

Look forward to our paths passing again soon, if only in cyberspace.

This thread is now locked and can not be replied to.

What is Amazon Go and will it come to the UK? The store without checkouts or queues

1995-2015: How technology has changed the world in 20 years

Why ecommerce hasn't taken off on social media

Super Mario Run preview | Hands-on first impressions of Super Mario Run: Mario's iPhone & iPad…