UK Bingo cards

[craigey1]

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

 

[braindiesel]

Interesting, and not sure if I will get it but looks like a good challenge.
Question...
Is it possible that a cardhave a column with 3 numbers in it and anotehr columne has 0 numbers in it

 

[craigey1]

No - It'll have at least 1 number, but a maximum of 2.

 

[craigey1]

Sorry can't seem to edit the post - Originally post says:
3. An individual box has 15 numbers, 5 per row and between 0 and 2 per column
but it should say between 1 and 2 per column

 

[Dave Patton]

check the following site to see if the ideas help

Create Bingo Cards in Excel - Contextures Blog

To generate the random numbers, there are three sets of lists on the Numbers sheet. In each set, there are typed numbers 1-75, with the formula =RAND() in the

contexturesblog.com

 

[craigey1]

check the following site to see if the ideas help

Create Bingo Cards in Excel - Contextures Blog

To generate the random numbers, there are three sets of lists on the Numbers sheet. In each set, there are typed numbers 1-75, with the formula =RAND() in the

contexturesblog.com

I've given that a go & managed to get a 3 * 9 grid populated with the appropriate numbers. I got 2 cards to be generated from the same numbers table, but a 3rd always produced a NUM! error on all but the last column - I suspect due to the additional number 90 in the table.

I'm not sure how I'd then go about adding in the blank spaces or how to generate the additional cards using the unused numbers or how to reuse the numbers that would be covered over when inserting the blanks.

 

[Dave Patton]

Hello craigey1
I never tried to create the Bingo cards. I just recalled that Debra had an example on her site.
If you are still having troubles, you can post an example with XL2BB. Please describe your problem and
explain what is different in your sheet compared to Debra's.

Hopefully someone will be able to answer your questions.

 

[craigey1]

TBH I thought the screenshots would help with clarifying the issue. The formula on the link you provided uses INDEX / Match & all I've done it adjusted the cell vales it looks for.
Anyway here goes:
Cards sheet has:

BingoCard.xls
	A	B	C	D	E	F	G	H	I	J
1
2		4	16	29	36	44	56	64	75	85
3		2	10	28	34	49	52	60	77	89
4		9	18	26	30	46	50	66	70	84
5
6
7		8	13	21	37	47	55	61	72	81
8		1	12	22	33	41	58	62	73	88
9		3	17	25	32	48	51	67	76	87
10
11
12		#####	#####	#####	#####	#####	#####	#####	#####	86
13		#####	#####	#####	#####	#####	#####	#####	#####	#####
14		#####	#####	#####	#####	#####	#####	#####	#####	#####
Cards

Cell Formulas
Range	Formula
B12:B14,B7:B9,B2:B4	B2	=INDEX(Numbers!$A$1:$A$9,MATCH(LARGE(Numbers!$B$1:$B$9,ROW()-1),Numbers!$B$1:$B$9,0))
C12:C14,C7:C9,C2:C4	C2	=INDEX(Numbers!$D$1:$D$10,MATCH(LARGE(Numbers!$E$1:$E$10,ROW()-1),Numbers!$E$1:$E$10,0))
D12:D14,D7:D9,D2:D4	D2	=INDEX(Numbers!$G$1:$G$10,MATCH(LARGE(Numbers!$H$1:$H$10,ROW()-1),Numbers!$H$1:$H$10,0))
E12:E14,E7:E9,E2:E4	E2	=INDEX(Numbers!$J$1:$J$10,MATCH(LARGE(Numbers!$K$1:$K$10,ROW()-1),Numbers!$K$1:$K$10,0))
F12:F14,F7:F9,F2:F4	F2	=INDEX(Numbers!$M$1:$M$10,MATCH(LARGE(Numbers!$N$1:$N$10,ROW()-1),Numbers!$N$1:$N$10,0))
G12:G14,G7:G9,G2:G4	G2	=INDEX(Numbers!$P$1:$P$10,MATCH(LARGE(Numbers!$Q$1:$Q$10,ROW()-1),Numbers!$Q$1:$Q$10,0))
H12:H14,H7:H9,H2:H4	H2	=INDEX(Numbers!$S$1:$S$10,MATCH(LARGE(Numbers!$T$1:$T$10,ROW()-1),Numbers!$T$1:$T$10,0))
I12:I14,I7:I9,I2:I4	I2	=INDEX(Numbers!$V$1:$V$10,MATCH(LARGE(Numbers!$W$1:$W$10,ROW()-1),Numbers!$W$1:$W$10,0))
J12:J14,J7:J9,J2:J4	J2	=INDEX(Numbers!$Y$1:$Y$11,MATCH(LARGE(Numbers!$Z$1:$Z$11,ROW()-1),Numbers!$Z$1:$Z$11,0))

Numbers sheet has:

BingoCard.xls
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z
1	1	0.372		10	0.919		20	0.061		30	0.726		40	0.795		50	0.812		60	0.843		70	0.65		80	0.555
2	2	0.772		11	0.677		21	0.264		31	0.658		41	0.362		51	0.262		61	0.585		71	0.618		81	0.407
3	3	0.317		12	0.496		22	0.225		32	0.549		42	0.617		52	0.826		62	0.553		72	0.48		82	0.248
4	4	0.98		13	0.532		23	0.003		33	0.579		43	0.338		53	0.732		63	0.652		73	0.309		83	0.164
5	5	0.654		14	0.017		24	0.455		34	0.754		44	0.961		54	0.728		64	0.912		74	0.208		84	0.57
6	6	0.612		15	0.831		25	0.074		35	0.134		45	0.036		55	0.663		65	0.139		75	0.85		85	0.723
7	7	0.284		16	0.997		26	0.658		36	0.829		46	0.831		56	0.971		66	0.839		76	0.279		86	0.094
8	8	0.48		17	0.255		27	0.495		37	0.598		47	0.467		57	0.213		67	0.506		77	0.821		87	0.26
9	9	0.72		18	0.901		28	0.726		38	0.666		48	0.356		58	0.615		68	0.744		78	0.6		88	0.388
10				19	0.113		29	0.894		39	0.388		49	0.959		59	0.165		69	0.203		79	0.124		89	0.722
11																									90	0.411
Numbers

Cell Formulas
Range	Formula
Z1:Z11,W1:W10,T1:T10,Q1:Q10,N1:N10,K1:K10,H1:H10,E1:E10,B1:B9	B1	=RAND()

 

[lrobbo314]

You can use the code below. You can speed it up a bit by turning screenupdating off, but I kind of liked the effect of the code running through the cards.

20200407 MXL Bingo.xlsm
	A	B	C	D	E	F	G	H	I	J
1	5		24	36	49		70	77	87	Card 1
2		18	21			60
3	2			33	46	51	62
4	6	16			42			73		Card 2
5			22	39		55	65	75
6	9	15		34		58	69		85
7		14			44				82	Card 3
8	10	17	29	31	41	57	63		81
9			28			59		79
10		12	27	38	43			74	86	Card 4
11		20			48	56	64		84
12	4		25				66	72
13	3				45				88	Card 5
14		13	23	37				76	90
15	1	19		40	47	54	61	71
16	8	11	26	35	50	53	67	78	83	Card 6
17				32		52	68
18	7		30					80	89
Sheet2

Sub Main()
Dim AR() As Variant: ReDim AR(1 To 18, 1 To 9)
Dim AVAIL As Object: setAvail AVAIL
Dim NUMS As Object: setNums NUMS
Dim SP() As String
Dim Card As Integer, Spot As Integer, rNum As Integer
Dim CD As Integer: CD = 9
Dim Col As Integer: Col = 1
Dim b As Boolean: b = False

Do
    Do Until Col > 9
        Card = AVAIL.keys()(getRand(AVAIL.Count - 1, 0))
        Do
            SP = Split(AVAIL(Card), "-")
            Spot = getRand(SP(1), SP(0))
        Loop Until AR(Spot, Col) = vbNullString
        rNum = getRand(CD, 0)
        AR(Spot, Col) = NUMS(rNum)
        If Not checkCard(AR, SP(1), SP(0), Col) Then AVAIL.Remove Card
        NUMS.Remove NUMS(rNum)
        CD = CD - 1
        If CD < 0 Then
            CD = 9
            setAvail AVAIL
            Col = Col + 1
        End If
    Loop
    Range("A1:I18") = AR
    If Not finalCheck Then
        Reset AVAIL, NUMS, AR, Col, CD
    Else
        b = True
    End If
Loop Until b = True
       
End Sub

Sub Reset(ByRef AVAIL As Object, ByRef NUMS As Object, ByRef AR() As Variant, ByRef Col As Integer, ByRef CD As Integer)
setAvail AVAIL
setNums NUMS
Col = 1
CD = 9
ReDim AR(1 To 18, 1 To 9)
Range("A1:I18").ClearContents
End Sub

Function getRand(hi As Variant, lo As Variant) As Integer
getRand = Int(((hi + 1) - lo) * Rnd() + lo)
End Function

Sub setAvail(ByRef AVAIL As Object)
Set AVAIL = CreateObject("Scripting.Dictionary")
Dim id As Integer: id = 0
For i = 0 To 17 Step 3: AVAIL.Add id, Join(Array(i + 1, i + 3), "-"): id = id + 1: Next i
End Sub

Sub setNums(ByRef NUMS As Object)
Set NUMS = CreateObject("System.Collections.ArrayList")
For i = 1 To 90: NUMS.Add i: Next i
End Sub

Function checkCard(ByRef AR() As Variant, hi As Variant, lo As Variant, Col As Integer) As Boolean
Dim total As Integer: total = 0
For i = lo To hi
    If AR(i, Col) <> vbNullString Then
        total = total + 1
    End If
Next i
checkCard = total < 2
End Function

Function finalCheck() As Boolean
Dim r As Range
Dim b As Boolean: b = True
ActiveSheet.UsedRange.Interior.ColorIndex = -4142
For Ro = 1 To 18 Step 3
    For Col = 1 To 9
        Set r = Range(Cells(Ro, Col), Cells(Ro + 2, Col))
        If Application.WorksheetFunction.CountBlank(r) = 3 Then finalCheck = False: Exit Function
    Next Col
Next Ro
finalCheck = b
End Function

 

[craigey1]

You can use the code below. You can speed it up a bit by turning screenupdating off, but I kind of liked the effect of the code running through the cards.
....

Thanks - I haven't had a chance to look through this yet, but it looks like it could be just the job. Very much appreciated, Sir!