Lottery Bingo Conundrum

LambChops · May 16, 2014

At work we run a lottery bingo where 30 people pick 6 numbers each from a total of 30 numbers, the easy bit is highlighting a persons number when one is drawn using conditional formatting but I need to highlight a person if they have absolutely no chance of winning the game due to other people waiting on a number they require, for example;

Person1 is waiting for numbers 1 & 2 to come up
Person2 is waiting for number 1 to come up
Person3 is waiting for number 2 to come up

It is impossible for person1 to win as no matter which number is drawn (1 or 2) someone else will win and in this case they stop paying into the current game and start paying into the next game.

It can also be impossible for person1 to win if others are waiting for more than 1 number: -

Person1 is waiting for numbers 1,2,3 & 4 to come up
Person2 is waiting for number 1 & 2 to come up
Person3 is waiting for number 3 & 4 to come up

So how can this be solved programatically or via formulas?

Thanks

StephenCrump · May 16, 2014

You'll need to start testing after round 1. For example, if "7" is drawn first round and starting positions were:

Person A: 1,2,3,4,5,6
Person B: 1,2,3,4,5,7
Person C: 2,3,4,5,6,7

then already A can't win.

Programatically, the condition to test for each person X is if there exist two other people whose outstanding numbers:

1. Are both fewer than X's, and
2. Are a subset of X's numbers, and
3. Aren't identical.

If these conditions are satisfied, then person X can't win (or share a win).

shg · May 17, 2014

This is a little tortured, but you mean a result like this?

	B	C	D	E	F	G	H	I	J	K
2	Draws		Name	N1	N2	N3	N4	N5	N6	Can't Beat
3	30		Alan	2	4	6	8	16	22	Leah,Xana,Yuri
4	15		Barb	1	5	12	19	23	26	Alan,Leah,Xana,Yuri
5	18		Cain	9	12	15	21	23	24	Leah,Xana,Yuri
6	23		Dana	1	6	11	24	29	30	Xana,Yuri
7	13		Eric	9	10	11	14	21	28	Leah,Xana,Yuri
8	24		Fran	4	5	9	13	22	25	Alan,Leah,Xana,Yuri
9	27		Gary	3	5	9	22	25	28	Leah,Xana,Yuri
10	11		Hana	3	8	11	12	15	27
11	8		Ivan	1	11	15	18	26	30	Xana,Yuri
12	14		Jane	7	20	22	25	27	30	Leah,Xana,Yuri
13	3		Kent	5	6	18	19	20	30	Leah,Xana,Yuri
14	6		Leah	2	4	6	13	16	28	Xana,Yuri
15	28		Mark	9	11	13	15	24	28
16	25		Nina	1	2	11	21	25	26	Alan,Leah,Xana,Yuri
17	16		Otto	4	11	14	16	21	27	Xana,Yuri
18			Peri	5	9	13	22	26	30	Alan,Leah,Xana,Yuri
19			Quin	8	15	16	17	21	25	Xana,Yuri
20			Rene	2	7	12	13	22	23	Alan,Leah,Xana,Yuri
21			Seth	4	5	8	9	15	20	Alan,Leah,Xana,Yuri
22			Tina	2	5	16	19	22	29	Alan,Leah,Xana,Yuri
23			Ulis	1	6	9	15	22	29	Alan,Leah,Xana,Yuri
24			Vera	2	3	4	12	21	27	Alan,Leah,Xana,Yuri
25			Wade	7	11	16	18	19	26	Leah,Xana,Yuri
26			Xana	3	8	15	18	22	27
27			Yuri	2	3	11	15	24	30
28			Zuni	4	7	17	19	23	29	Alan,Leah,Xana,Yuri

StephenCrump · May 17, 2014

Silly me, I wasn't intending to spend any more time on this ....

Using shg's layout and data, and defining range names:

NumbersDrawn: B3:B32
NumbersSelected: E3:J28
RoundNo (= 1, 2, 3 etc) in some other cell, then the code below will tell you that:

If RoundNo = 15
Alan can't win because of the combination of Leah/Xani/Yuri
Barb can't win because of Hana/Ivan
Cain can't win because of Hana/Mark
etc etc

The first players eliminated are in Round 9:
Gary because of Mark/Xana
Vera because of Hana/Yuri

Code:

Sub TestBingoWinners()

    Dim vNumbersDrawn As Variant, vNumbersSelected As Variant
    Dim lNoPlayers As Long, lNumbersDrawn As Long
    Dim lCount As Long
    Dim i As Long, j As Long, k As Long, n As Long, p As Long
    Dim lFirst As Long, lSecond As Long
    Dim bNumbersOutstanding() As Boolean, lCountOutstanding() As Long
    Dim lPlayersToTest() As Long, lNoPlayersToTest As Long
    Dim lRoundNo As Long
    Dim bTestThisPlayer As Boolean, bGameWon As Boolean, bPlayerLoses As Boolean
    Const NOS = 30
    Const NO_SELECTED = 6
    
    vNumbersDrawn = [NumbersDrawn].Value
    vNumbersSelected = [NumbersSelected].Value
    lNoPlayers = UBound(vNumbersSelected, 1)
    lRoundNo = [RoundNo]
    ReDim bNumbersOutstanding(1 To lNoPlayers, 1 To NOS)
    ReDim lCountOutstanding(1 To lNoPlayers)
    ReDim lPlayersToTest(1 To lNoPlayers)
    
    For i = 1 To lNoPlayers
        'Initial position
        lCountOutstanding(i) = NO_SELECTED
        For n = 1 To NO_SELECTED
            bNumbersOutstanding(i, vNumbersSelected(i, n)) = True
        Next n
        'Position after the given numbers have been drawn
        For n = 1 To lRoundNo
            If bNumbersOutstanding(i, vNumbersDrawn(n, 1)) Then
                bNumbersOutstanding(i, vNumbersDrawn(n, 1)) = False
                lCountOutstanding(i) = lCountOutstanding(i) - 1
                If lCountOutstanding(i) = 0 Then
                    MsgBox "Round " & n & ": Player " & i & " is a winner!"
                    bGameWon = True
                    Exit For
                End If
            End If
        Next n
    Next i
    If bGameWon Then GoTo EndSub
    
    For i = 1 To lNoPlayers
        'Test for other players that may always win
        lNoPlayersToTest = 0
        For p = 1 To lNoPlayers
            bTestThisPlayer = False
            If p <> i And lCountOutstanding(p) < lCountOutstanding(i) Then
                bTestThisPlayer = True
                For n = 1 To NOS
                    If bNumbersOutstanding(p, n) And Not bNumbersOutstanding(i, n) Then
                        bTestThisPlayer = False
                        Exit For
                    End If
                Next n
                If bTestThisPlayer Then
                    lNoPlayersToTest = lNoPlayersToTest + 1
                    lPlayersToTest(lNoPlayersToTest) = p
                End If
            End If
        Next p
        For j = 1 To lNoPlayersToTest
            For k = j + 1 To lNoPlayersToTest
                lFirst = lPlayersToTest(j)
                lSecond = lPlayersToTest(k)
                For n = 1 To NOS
                    If bNumbersOutstanding(lFirst, n) <> bNumbersOutstanding(lSecond, n) Then
                        Exit For    'Success!
                    End If
                Next n
                If n <= NOS Then
                    MsgBox "Round " & lRoundNo & ": Player " & i & " can't win because of players " _
                        & lFirst & " and " & lSecond
                    bPlayerLoses = True
                End If
            Next k
        Next j
    Next i
    If Not bPlayerLoses Then MsgBox "No results yet ..."

EndSub:

End Sub

shg · May 18, 2014

Mine was formula-based, other than the catenation, but Stephen's solution seems good as well.

StephenCrump · May 18, 2014

shg said:
Stephen's solution seems good as well.

Oops, actually it's not ...

My condition 3 isn't right. If:
A is waiting on 1,2,3,4
B is waiting on 1 and 2
C is waiting on 1

then A can still share a win if "1" is the last number to drop. The correct condition is that B and C each need to cover at least one number not in common.

Here's my slightly revised code, which I think now works perfectly. It selects B or C depending on who has the fewer numbers remaining (C in this case) and checks to ensure C has at least one number that B doesn't.

Code:

Sub TestBingoWinners()

    Dim vNumbersDrawn As Variant, vNumbersSelected As Variant
    Dim lNoPlayers As Long, lNumbersDrawn As Long
    Dim lCount As Long
    Dim i As Long, j As Long, k As Long, n As Long, p As Long
    Dim lFirst As Long, lSecond As Long
    Dim bNumbersOutstanding() As Boolean, lCountOutstanding() As Long
    Dim lPlayersToTest() As Long, lNoPlayersToTest As Long
    Dim lRoundNo As Long, lFewerNumbers As Long, lMoreNumbers As Long
    Dim bTestThisPlayer As Boolean, bGameWon As Boolean, bPlayerLoses As Boolean
    Const NOS = 30
    Const NO_SELECTED = 6
    
    vNumbersDrawn = [NumbersDrawn].Value
    vNumbersSelected = [NumbersSelected].Value
    lNoPlayers = UBound(vNumbersSelected, 1)
    lRoundNo = [RoundNo]
    ReDim bNumbersOutstanding(1 To lNoPlayers, 1 To NOS)
    ReDim lCountOutstanding(1 To lNoPlayers)
    ReDim lPlayersToTest(1 To lNoPlayers)
    
    For i = 1 To lNoPlayers
        'Initial position
        lCountOutstanding(i) = NO_SELECTED
        For n = 1 To NO_SELECTED
            bNumbersOutstanding(i, vNumbersSelected(i, n)) = True
        Next n
        'Position after the given numbers have been drawn
        For n = 1 To lRoundNo
            If bNumbersOutstanding(i, vNumbersDrawn(n, 1)) Then
                bNumbersOutstanding(i, vNumbersDrawn(n, 1)) = False
                lCountOutstanding(i) = lCountOutstanding(i) - 1
                If lCountOutstanding(i) = 0 Then
                    MsgBox "Round " & n & ": Player " & i & " is a winner!"
                    bGameWon = True
                    Exit For
                End If
            End If
        Next n
    Next i
    If bGameWon Then GoTo EndSub
    
    For i = 1 To lNoPlayers
        'Test for other players that may always win
        lNoPlayersToTest = 0
        For p = 1 To lNoPlayers
            bTestThisPlayer = False
            If p <> i And lCountOutstanding(p) < lCountOutstanding(i) Then
                bTestThisPlayer = True
                For n = 1 To NOS
                    If bNumbersOutstanding(p, n) And Not bNumbersOutstanding(i, n) Then
                        bTestThisPlayer = False
                        Exit For
                    End If
                Next n
                If bTestThisPlayer Then
                    lNoPlayersToTest = lNoPlayersToTest + 1
                    lPlayersToTest(lNoPlayersToTest) = p
                End If
            End If
        Next p
        For j = 1 To lNoPlayersToTest
            For k = j + 1 To lNoPlayersToTest
                lFirst = lPlayersToTest(j)
                lSecond = lPlayersToTest(k)
                If lCountOutstanding(lFirst) < lCountOutstanding(lSecond) Then
                    lFewerNumbers = lFirst
                    lMoreNumbers = lSecond
                Else
                    lFewerNumbers = lSecond
                    lMoreNumbers = lFirst
                End If
                For n = 1 To NOS
                    If bNumbersOutstanding(lFewerNumbers, n) And Not bNumbersOutstanding(lMoreNumbers, n) Then
                        Exit For    'Success!
                    End If
                Next n
                If n <= NOS Then
                    MsgBox "Round " & lRoundNo & ": Player " & i & " can't win because of players " _
                        & lFirst & " and " & lSecond
                    bPlayerLoses = True
                End If
            Next k
        Next j
    Next i
    If Not bPlayerLoses Then MsgBox "No results yet ..."

EndSub:

End Sub

LambChops · May 18, 2014

Thanks everyone, that works perfectly.

Can I just ask what
Const NOS = 30 refers to in the code?

Thanks again.

StephenCrump · May 18, 2014

NOS is just the number of possible numbers that can be drawn, i.e. 1, 2, 3, ... 29, 30.

If NOS wasn't defined, we'd have hard-coded "30"s peppered through the code.

Suppose the lottery draw later changes from 30 to 40 numbers. Someone would have to go through the code deciding whether to change each 30 to 40. At each step, they have to ask the question: Is this particular 30 the number of numbers, or the the number of people? Or perhaps the number of draws? Or something else entirely?

Far easier, and much better coding practice, to define NOS once up front.

LambChops · May 21, 2014

I think there is still an issue with players who can't win outright and those who can be joint winners ;

For example 3 players whose numbers are as follows ;

Player1 3,5,8,11,12 & 19
Player2 3,7,8,12,16 & 19
Player3 7,11,13,17,19 & 21

If the drawn numbers come out as 3,5,21,13,12,17,16,7 & 21 leaving

Player1 waiting for 8,11 & 19
Player2 waiting for 8 & 19
Player3 waiting for 11 & 19

then the code reckons that player 1 cannot win due to players 2 & 3 but if the next numbers to be drawn are 8 & 11 then all 3 players would win when number 22 is drawn?

StephenCrump · May 21, 2014

Sorry, you're right. I should have thunk the logic better in the first place

....

In this example, we need an additional Player 4 waiting on 8 and 11 to guarantee Player 1 can't win.

It may be a combination of several players, not just two, that guarantees a particular player can't win. The key condition is that this player group can't all be waiting on a common number. For example:

Player 1 needs: 1 2 3 4 5
Player 2 needs: 1 2 3
Player 3 needs: 2 4
Player 4 needs: 2 5

then Player can still share a win if 2 is the last number to drop.

but if we also have:

Player 5 needs: 1 3 4 5

then Player 1 can't win.

The logic is that for each of Player 1's numbers, there is at least one other Player (in this select group who are also waiting on only a subset of A's numbers) who doesn't have that number, i.e. for any given number that could drop last, that player will have won already.

Easily fixed ... I'll send you revised code within a few hours.

Lottery Bingo Conundrum

LambChops

New Member

Excel Facts

StephenCrump

MrExcel MVP

shg

MrExcel MVP

StephenCrump

MrExcel MVP

shg

MrExcel MVP

StephenCrump

MrExcel MVP

LambChops

New Member

StephenCrump

MrExcel MVP

LambChops

New Member

StephenCrump

MrExcel MVP

Similar threads

Forum statistics

Share this page

Lottery Bingo Conundrum

New Member

Excel Facts

MrExcel MVP

MrExcel MVP

MrExcel MVP

MrExcel MVP

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock