UK Bingo cards

C

craigey1

New Member
Joined
Apr 6, 2020
Messages
30
Office Version
  1. 2019
Platform
  1. Windows
Apologies for asking for so much help on my very first post here.

I've been searching all over for a solution to be able to produce a UK style bingo card within Excel using formulas or VBA, but so far have only found code that's capable of producing singular games rather than a set of 6. I've searched here & seen that the question has been asked before, but so far no-one seems to have been able to come up with a solution. I thought I could look at randbetween() to generate the necessary numbers for each column, but couldn't see how to then comply the required game layout rules. I really don't know where to start with this. I'd normally try & then ask for help when stuck, so here I am!

The UK bingo games use numbers 1 to 90 (including 90) with the numbers split across 6 games of 3 rows by 9 columns. The number 1 to 9 would appear in the first column, 10 to 19 in column 2, 20 to 29 column 3 & so on until the 9th column which also includes the number 90. All numbers would only appear once across all 6 of the games & each box has 5 blanks across each row & can have 0, 1 or 2 blanks per column.
In summary:
1. A bingo 'card' is a set of 6 individual 3 x 9 grids, stacked vertically, which contain the numbers 1-90
2. The numbers 1 - 9 (9 numbers) are in the first column and 80-90 (11 numbers) in the 9th, the intervening columns (2-8) contain 10 numbers each.
3. An individual box has 15 numbers, 5 per row and between 0 and 2 per column

I'd appreciate any help with this as was hoping to generate cards for friends / family during the lockdown.

thanks in advance

jumbobingoticket-jpg.10662
 

Attachments

  • JumboBingoTicket.jpg
    JumboBingoTicket.jpg
    119 KB · Views: 3,418
Sort by date Sort by votes
lrobbo314 said:
Got a good feeling about this one, lol.
Click to expand...

You sir are a genius. That works perfectly.

I'm going to have to through the code & try to figure out what it's doing (I know a little vb - I can use arrays & loop through & use if / case statements etc, but no where near enough to follow what this is doing, yet).
Is there anything I can do to thank you for your effort? Can donate to a charity on your behalf or buy you a coffee / beer etc (hope that's not against the rules & wouldn't always do it, but you've spent a lot of time & effort coming up with this solution).

Thanks again.
 
Upvote 0

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
craigey1 said:
You sir are a genius. That works perfectly.

I'm going to have to through the code & try to figure out what it's doing (I know a little vb - I can use arrays & loop through & use if / case statements etc, but no where near enough to follow what this is doing, yet).
Is there anything I can do to thank you for your effort? Can donate to a charity on your behalf or buy you a coffee / beer etc (hope that's not against the rules & wouldn't always do it, but you've spent a lot of time & effort coming up with this solution).

Thanks again.
Click to expand...

Thanks for the nice comments. I appreciate the sentiment for a donation or a beer. I started a youtube channel with Excel tutorials. If you're interested in checking out those videos that would be awesome.

Either way, glad we got it sorted out.
 
Upvote 0
braindiesel said:
braindiesel said:
Question...
Is it possible that a cardhave a column with 3 numbers in it and anotehr columne has 0 numbers in it
Click to expand...
craigey1 said:
No - It'll have at least 1 number, but a maximum of 2.
Click to expand...
Click to expand...
Are you sure about the "maximum of 2" restriction? I ask because Wikipedia says this...

"Strips of 6 tickets
A typical bingo ticket contains 27 spaces, arranged in nine columns by three rows. Each row contains five numbers and four blank spaces. Each column contains up to three numbers..."

Here is the link for that citation... Bingo (British version) - Wikipedia
 
Upvote 0
Rick Rothstein said:
Are you sure about the "maximum of 2" restriction? I ask because Wikipedia says this...

"Strips of 6 tickets
A typical bingo ticket contains 27 spaces, arranged in nine columns by three rows. Each row contains five numbers and four blank spaces. Each column contains up to three numbers..."
Click to expand...
It appears you are quite correct. Sorry. I was going from memory & the example ticket that I posted in the first post.
Hmmm. I'll have to have a play & see if I can figure this out (or just randomly change values until it looks right)!
 
Upvote 0
Hi there, did you manage to get this working in the end, I've been trying to find something similar that takes account of the 3 numbers per column rule. It would also be useful to know how to put a blank line between each game for formatting purposes. I wish my vba knowledge was up to scratch to be able to produce something like this.
 
Upvote 0
@tezza asked a question about this old post.

I noticed what Rick said about the, maximum of 2, in post #24.

So, I revisited it and this code seems to fill out the card with all the correct parameters in place.

VBA Code: 
Sub QMAIN()
Dim Output(1 To 18, 1 To 9) As Variant
Dim r As Range:                 Set r = Range("A1").Resize(UBound(Output), UBound(Output, 2))
Dim AR(1 To 90) As Integer:     fillNums AR: Shuffle AR
Dim QUE As Object:              fillQueue QUE, AR
Dim PAT As Object:

r.ClearContents
FillOutput QUE, Output, PAT
r.Value = Output
End Sub

Sub NumPatterns(ByRef PAT As Object, Total As Integer)
Randomize
Dim r As Double:    r = Rnd
Set PAT = CreateObject("System.Collections.ArrayList")

Select Case Total
    Case 9
        If r < 0.5 Then
            PAT.Add Array(1, 1, 1)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
        Else
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
        End If
    Case 10
        If r < 0.5 Then
            PAT.Add Array(1, 1, 1)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
        Else
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
        End If
    Case 11
        If r < 0.5 Then
            PAT.Add Array(1, 1, 1)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
        Else
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
        End If
End Select
        
End Sub

Sub fillQueue(ByRef Queue As Object, ByRef AR() As Integer)
Set Queue = CreateObject("System.Collections.Queue")
For i = 1 To UBound(AR)
    Queue.enqueue AR(i)
Next i
End Sub

Sub fillNums(ByRef AR() As Integer)
For i = 1 To 90: AR(i) = i: Next i
End Sub

Sub Shuffle(ByRef AR() As Integer)
Randomize
Dim Group As Integer, swap As Integer, TMP As Integer, gs As Integer

gs = 9

For i = 1 To UBound(AR) - 1
    If i = 10 Then gs = gs + 1
    If i < 10 Then
        Group = Int((i - 1) / gs) * gs
        swap = getRnd(Group + gs, Group + 1)
    ElseIf i < UBound(AR) - 10 Then
        Group = Int((i) / gs) * gs
        swap = getRnd(Group, Group + 10)
    Else
        Group = Int((i) / gs) * gs
        swap = getRnd(Group, Group + 11)
    End If
    
    TMP = AR(i)
    AR(i) = AR(swap)
    AR(swap) = TMP
Next i
End Sub

Sub FillOutput(QUE As Object, Output As Variant, PAT As Object)
Dim COL As Integer:     COL = 1

For i = 1 To 9
    MatchPat COL, PAT, QUE, Output
    PAT.Clear
    COL = COL + 1
Next i
    
Range("A1").Resize(UBound(Output), UBound(Output, 2)).Value = Output
End Sub

Sub MatchPat(COL As Integer, PAT As Object, QUE As Object, Output As Variant)
Dim Total As Integer
Dim RP As Integer
Dim PA As Variant
Dim RG As Integer:      RG = 1
Dim RO As Integer:      RO = 1

Select Case COL
    Case 1
        Total = 9
    Case 9
        Total = 11
    Case Else
        Total = 10
End Select

NumPatterns PAT, Total

Do Until PAT.Count = 0
    RP = getRnd(PAT.Count - 1, 0)
    PA = PAT(RP)
    PAT.removeat (RP)
    MIXLAST PA
    
    For p = 0 To 2
        If PA(p) = 1 Then Output(p + RG, COL) = QUE.deQueue()
    Next p
    
    RG = RG + 3
Loop

End Sub

Sub MIXLAST(TMP As Variant)
Dim t As Integer
Dim v As Integer

For i = 0 To 2
    t = getRnd(2, 0)
    v = TMP(i)
    TMP(i) = TMP(t)
    TMP(t) = v
Next i
End Sub
 
Upvote 0
lrobbo314 said:
@tezza asked a question about this old post.

I noticed what Rick said about the, maximum of 2, in post #24.

So, I revisited it and this code seems to fill out the card with all the correct parameters in place.

VBA Code: 
Sub QMAIN()
Dim Output(1 To 18, 1 To 9) As Variant
Dim r As Range:                 Set r = Range("A1").Resize(UBound(Output), UBound(Output, 2))
Dim AR(1 To 90) As Integer:     fillNums AR: Shuffle AR
Dim QUE As Object:              fillQueue QUE, AR
Dim PAT As Object:

r.ClearContents
FillOutput QUE, Output, PAT
r.Value = Output
End Sub

Sub NumPatterns(ByRef PAT As Object, Total As Integer)
Randomize
Dim r As Double:    r = Rnd
Set PAT = CreateObject("System.Collections.ArrayList")

Select Case Total
    Case 9
        If r < 0.5 Then
            PAT.Add Array(1, 1, 1)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
        Else
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
        End If
    Case 10
        If r < 0.5 Then
            PAT.Add Array(1, 1, 1)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
        Else
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
        End If
    Case 11
        If r < 0.5 Then
            PAT.Add Array(1, 1, 1)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
        Else
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
        End If
End Select
       
End Sub

Sub fillQueue(ByRef Queue As Object, ByRef AR() As Integer)
Set Queue = CreateObject("System.Collections.Queue")
For i = 1 To UBound(AR)
    Queue.enqueue AR(i)
Next i
End Sub

Sub fillNums(ByRef AR() As Integer)
For i = 1 To 90: AR(i) = i: Next i
End Sub

Sub Shuffle(ByRef AR() As Integer)
Randomize
Dim Group As Integer, swap As Integer, TMP As Integer, gs As Integer

gs = 9

For i = 1 To UBound(AR) - 1
    If i = 10 Then gs = gs + 1
    If i < 10 Then
        Group = Int((i - 1) / gs) * gs
        swap = getRnd(Group + gs, Group + 1)
    ElseIf i < UBound(AR) - 10 Then
        Group = Int((i) / gs) * gs
        swap = getRnd(Group, Group + 10)
    Else
        Group = Int((i) / gs) * gs
        swap = getRnd(Group, Group + 11)
    End If
   
    TMP = AR(i)
    AR(i) = AR(swap)
    AR(swap) = TMP
Next i
End Sub

Sub FillOutput(QUE As Object, Output As Variant, PAT As Object)
Dim COL As Integer:     COL = 1

For i = 1 To 9
    MatchPat COL, PAT, QUE, Output
    PAT.Clear
    COL = COL + 1
Next i
   
Range("A1").Resize(UBound(Output), UBound(Output, 2)).Value = Output
End Sub

Sub MatchPat(COL As Integer, PAT As Object, QUE As Object, Output As Variant)
Dim Total As Integer
Dim RP As Integer
Dim PA As Variant
Dim RG As Integer:      RG = 1
Dim RO As Integer:      RO = 1

Select Case COL
    Case 1
        Total = 9
    Case 9
        Total = 11
    Case Else
        Total = 10
End Select

NumPatterns PAT, Total

Do Until PAT.Count = 0
    RP = getRnd(PAT.Count - 1, 0)
    PA = PAT(RP)
    PAT.removeat (RP)
    MIXLAST PA
   
    For p = 0 To 2
        If PA(p) = 1 Then Output(p + RG, COL) = QUE.deQueue()
    Next p
   
    RG = RG + 3
Loop

End Sub

Sub MIXLAST(TMP As Variant)
Dim t As Integer
Dim v As Integer

For i = 0 To 2
    t = getRnd(2, 0)
    v = TMP(i)
    TMP(i) = TMP(t)
    TMP(t) = v
Next i
End Sub
Click to expand...
Thank you, I will try give this a go and let you know.
 
Upvote 0
lrobbo314 said:
@tezza asked a question about this old post.

I noticed what Rick said about the, maximum of 2, in post #24.

So, I revisited it and this code seems to fill out the card with all the correct parameters in place.

VBA Code: 
Sub QMAIN()
Dim Output(1 To 18, 1 To 9) As Variant
Dim r As Range:                 Set r = Range("A1").Resize(UBound(Output), UBound(Output, 2))
Dim AR(1 To 90) As Integer:     fillNums AR: Shuffle AR
Dim QUE As Object:              fillQueue QUE, AR
Dim PAT As Object:

r.ClearContents
FillOutput QUE, Output, PAT
r.Value = Output
End Sub

Sub NumPatterns(ByRef PAT As Object, Total As Integer)
Randomize
Dim r As Double:    r = Rnd
Set PAT = CreateObject("System.Collections.ArrayList")

Select Case Total
    Case 9
        If r < 0.5 Then
            PAT.Add Array(1, 1, 1)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
        Else
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
        End If
    Case 10
        If r < 0.5 Then
            PAT.Add Array(1, 1, 1)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
        Else
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
        End If
    Case 11
        If r < 0.5 Then
            PAT.Add Array(1, 1, 1)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
            PAT.Add Array(1, 0, 0)
        Else
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 1, 0)
            PAT.Add Array(1, 0, 0)
        End If
End Select
       
End Sub

Sub fillQueue(ByRef Queue As Object, ByRef AR() As Integer)
Set Queue = CreateObject("System.Collections.Queue")
For i = 1 To UBound(AR)
    Queue.enqueue AR(i)
Next i
End Sub

Sub fillNums(ByRef AR() As Integer)
For i = 1 To 90: AR(i) = i: Next i
End Sub

Sub Shuffle(ByRef AR() As Integer)
Randomize
Dim Group As Integer, swap As Integer, TMP As Integer, gs As Integer

gs = 9

For i = 1 To UBound(AR) - 1
    If i = 10 Then gs = gs + 1
    If i < 10 Then
        Group = Int((i - 1) / gs) * gs
        swap = getRnd(Group + gs, Group + 1)
    ElseIf i < UBound(AR) - 10 Then
        Group = Int((i) / gs) * gs
        swap = getRnd(Group, Group + 10)
    Else
        Group = Int((i) / gs) * gs
        swap = getRnd(Group, Group + 11)
    End If
   
    TMP = AR(i)
    AR(i) = AR(swap)
    AR(swap) = TMP
Next i
End Sub

Sub FillOutput(QUE As Object, Output As Variant, PAT As Object)
Dim COL As Integer:     COL = 1

For i = 1 To 9
    MatchPat COL, PAT, QUE, Output
    PAT.Clear
    COL = COL + 1
Next i
   
Range("A1").Resize(UBound(Output), UBound(Output, 2)).Value = Output
End Sub

Sub MatchPat(COL As Integer, PAT As Object, QUE As Object, Output As Variant)
Dim Total As Integer
Dim RP As Integer
Dim PA As Variant
Dim RG As Integer:      RG = 1
Dim RO As Integer:      RO = 1

Select Case COL
    Case 1
        Total = 9
    Case 9
        Total = 11
    Case Else
        Total = 10
End Select

NumPatterns PAT, Total

Do Until PAT.Count = 0
    RP = getRnd(PAT.Count - 1, 0)
    PA = PAT(RP)
    PAT.removeat (RP)
    MIXLAST PA
   
    For p = 0 To 2
        If PA(p) = 1 Then Output(p + RG, COL) = QUE.deQueue()
    Next p
   
    RG = RG + 3
Loop

End Sub

Sub MIXLAST(TMP As Variant)
Dim t As Integer
Dim v As Integer

For i = 0 To 2
    t = getRnd(2, 0)
    v = TMP(i)
    TMP(i) = TMP(t)
    TMP(t) = v
Next i
End Sub
Click to expand...
Hi, I just run this at home on Excel 2010 and it stopped here:

Screenshot 2022-12-13 215552.jpg


Maybe 2010 is too old so I will try in work this week, but whilst the home pc run the previous version ok, the works laptop failed.

Thank you for revisiting this :)
 
Upvote 0
Nope, my fault. Missed a function. Paste the code in below the rest of the code and it should work.

VBA Code: 
Function getRnd(hi As Variant, lo As Variant) As Integer
getRnd = Int(((hi + 1) - lo) * Rnd() + lo)
End Function
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Question Question
Creating a random sequence of items from a weighted list with no duplicates
Replies
6
Views
115
shg
shg
M
  • Question Question
Spot It or Dobble
Replies
2
Views
400
ManUBlueJay
M
K
  • Question Question
Bingo Board Formula
Replies
5
Views
590
KiwiNan
K
B
  • Question Question
Simulator for one event in blackjack game
Replies
2
Views
381
baha17
B
G
  • Question Question
Predict Blackjack cards?
2
Replies
10
Views
1K
Joe4
Joe4

Forum statistics

Threads
1,223,246
Messages
6,170,999
Members
452,373
Latest member
TimReeks

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top