Results 1 to 11 of 11
  1. #1
    New Lounger
    Join Date
    Nov 2014
    Posts
    21
    Thanks
    16
    Thanked 1 Time in 1 Post

    Checking Bingo Cards

    Howdy,

    I have a spreadsheet with some randomly produced Bingo cards. At the top are the picked numbers that need to be checked against the cards for Bingo. My VB skills are not honed enough to get it right. On my 8th attempt (failure), I decided to turn to the forum experts for some help.

    Attached is a stripped version of the sheet with the 6 cards and the picked numbers at the top. What I would like to accomplish is to have a button, that when pressed, will highlight all the matching numbers on the card.

    Bingo.png

    Thank you,
    Nicole
    Last edited by Nicole545; 2016-06-21 at 16:49.

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Nicole,

    Could you attach the actual spreadsheet and not a picture of it!
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  3. #3
    New Lounger
    Join Date
    Nov 2014
    Posts
    21
    Thanks
    16
    Thanked 1 Time in 1 Post
    Sorry, I thought I had.
    Attached Files Attached Files

  4. #4
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,635
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Nicole,

    Can We assume that since this is bingo, all the numbers are unique (1-75) and each column on the card can be 15 numbers?

  5. #5
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Nichole,

    You can do this with conditional formatting.
    The one thing is you have to list the "called" numbers in a single Row or Column.

    BingoCond.PNG

    BingoCond2.PNG

    Formula: =IFERROR(MATCH(A6,$A$1:$AD$1,0)>0,FALSE)

    Sample File: BingoGame-RGv1.xlsx

    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  6. The Following User Says Thank You to RetiredGeek For This Useful Post:

    Nicole545 (2016-06-25)

  7. #6
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,635
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Nicole,

    Here is a VBA approach using Check Bingo and Reset buttons:

    In a Standard module
    Code:
    Sub CheckBingo()
    Application.ScreenUpdating = False
    Dim cell1 As Range, cell2 As Range
    For Each cell1 In Range("Picks")
        For Each cell2 In Range("Cards")
            If cell2 = "FREE" Then cell2.Interior.Color = vbMagenta
            If cell1 = cell2 Then cell2.Interior.Color = vbMagenta
        Next cell2
    Next cell1
    Application.ScreenUpdating = True
    End Sub
    
    
    Sub Reset()
        Range("Cards").Interior.Pattern = xlNone
    End Sub
    Bingo1.png

    HTH,
    Maud
    Attached Files Attached Files

  8. The Following User Says Thank You to Maudibe For This Useful Post:

    Nicole545 (2016-06-25)

  9. #7
    New Lounger
    Join Date
    Nov 2014
    Posts
    21
    Thanks
    16
    Thanked 1 Time in 1 Post
    RG,

    Thank you for your solution. I had thought of conditional formatting but that will not work in my situation. If the markings were made automatically, it would take the fun out of it. The users will be "marking" the cards by selecting the numbers as the numbers are picked. I achieved this by coding the worksheet selectionchange in the sheet module.

    Maudibe,

    Your solution is what I am looking for. I haven't yet tested it out but your coding is so simple that I can't believe I wasn't even close. I will be attempting to modify your code to highlight the winning row/column/diagonals with yet a different color. Thanks for pointing me in the right direction.

    Nicole

  10. #8
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,635
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Nicole,

    I forgot to mention that the code points to a named range called "Cards" which is all of the number on the bingo cards

    Maud

  11. #9
    New Lounger
    Join Date
    Nov 2014
    Posts
    21
    Thanks
    16
    Thanked 1 Time in 1 Post
    Hi Maud,

    Sorry I haven't checked in but your code works. I have adapted your code into my work sheet and created ranges for each card. I have modified my worksheet change sub to use the ranges instead. I am trying to write the code that will highlight the row,column, or diagonal to test if bingo is true but having difficulties and getting error messages. Here is what I have so far
    Code:
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rnumber As Range, icolumn As Integer
    If Not Intersect(Target, Range("card1")) Is Nothing Then
        If Target.Interior.Color <> 15773696 Then
            Target.Interior.Color = 15773696
        Else: Target.Interior.Pattern = xlNone
        End If
    End If
    If Not Intersect(Target, Range("card2")) Is Nothing Then
        If Target.Interior.Color <> 15773696 Then
            Target.Interior.Color = 15773696
        Else: Target.Interior.Pattern = xlNone
        End If
    End If
    If Not Intersect(Target, Range("card3")) Is Nothing Then
        If Target.Interior.Color <> 15773696 Then
            Target.Interior.Color = 15773696
        Else: Target.Interior.Pattern = xlNone
        End If
    End If
    If Not Intersect(Target, Range("card4")) Is Nothing Then
        If Target.Interior.Color <> 15773696 Then
            Target.Interior.Color = 15773696
        Else: Target.Interior.Pattern = xlNone
        End If
    End If
    If Not Intersect(Target, Range("card5")) Is Nothing Then
        If Target.Interior.Color <> 15773696 Then
            Target.Interior.Color = 15773696
        Else: Target.Interior.Pattern = xlNone
        End If
    End If
    If Not Intersect(Target, Range("card6")) Is Nothing Then
        If Target.Interior.Color <> 15773696 Then
            Target.Interior.Color = 15773696
        Else: Target.Interior.Pattern = xlNone
        End If
    End If
    Target.Row.Select
    For Each rnumber In Selection
        If icolumn >= 1 And icolumn <= 5 Then
            If rnumber.Interior.Color = 15773696 Then
                MsgBox "Bingo"
            End If
        End If
    Next rnumber
    End Sub
    I know I am missing something, I just don't know what. I would appreciate it if you can nudge me along.

    Thanks Nicole

  12. #10
    Gold Lounger Maudibe's Avatar
    Join Date
    Aug 2010
    Location
    Pa, USA
    Posts
    2,635
    Thanks
    115
    Thanked 650 Times in 592 Posts
    Nicole,

    There are a couple of suggestions that you should consider (Changes in blue):

    1. Add checking to make sure that only one cell is selected

    2. After selecting a cell and changing the color, select another cell so that you can select it back and initiate a Worksheet_SelectionChange event. This gives you the ability to toggle the cell color on and off if the wrong bingo number is selected.

    3. Call a function outside of the sheet module that will check if the selected cell created bingo and then return a value of True of False to be used in additional code.

    Your Worksheet_SelectionChange procedure would look like this:
    Code:
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim win As Boolean
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("cards")) Is Nothing Then
        If Target.Interior.Color <> vbCyan Then
            Target.Interior.Color = vbCyan
        Else: Target.Interior.Pattern = xlNone
        End If
        Range("L3").Select
        win = CheckWin(Target)
        If win = True then
    
        'ADD CODE HERE IF BINGO
    
        End If
    End If
    End Sub
    3. Following the idea of your named ranges for each card, here is the function that will check for winners.

    In a standard module:
    Code:
    Public Function CheckWin(rng As Range) As Boolean
    '==================================================
    'CHECK FOR BINGO BY ASSIGNING POSSIBLE WINNING BINGO RANGES
    'BASED ON THE CELL SELECTED
    '==================================================
    'DECLARE AND SET VARIABLES
    Dim BingoRow As Range, BingoCol As Range, BingoDiag1 As Range, BingoDiag2 As Range, cell As Range
    Dim StartRow As Integer, EndRow As Integer, StartCol As Integer, EndCol As Integer, Bingo As Integer
    '--------------------------------------------------
    'CHECK FOR SELECTED CARD AND SET PARAMETERS FOR THAT CARD
        If Not Intersect(rng, Range("card1")) Is Nothing Then
            StartRow = 6:: EndRow = 10:: StartCol = 1:: EndCol = 5
        ElseIf Not Intersect(rng, Range("card2")) Is Nothing Then
            StartRow = 6:: EndRow = 10:: StartCol = 7:: EndCol = 11
        ElseIf Not Intersect(rng, Range("card3")) Is Nothing Then
            StartRow = 13:: EndRow = 17:: StartCol = 1:: EndCol = 5
        ElseIf Not Intersect(rng, Range("card4")) Is Nothing Then
            StartRow = 13:: EndRow = 17:: StartCol = 7:: EndCol = 11
        ElseIf Not Intersect(rng, Range("card5")) Is Nothing Then
            StartRow = 20:: EndRow = 24:: StartCol = 1:: EndCol = 5
        ElseIf Not Intersect(rng, Range("card6")) Is Nothing Then
            StartRow = 20:: EndRow = 24:: StartCol = 7:: EndCol = 11
        End If
    '--------------------------------------------------
    'SET A RANGE FOR EACH BINGO RANGE BASED ON CELL SELECTED
        Set BingoRow = Range(Cells(rng.Row, StartCol), Cells(rng.Row, EndCol)) 'ACROSS
        Set BingoCol = Range(Cells(StartRow, rng.Column), Cells(EndRow, rng.Column)) 'DOWN
        If StartCol = 1 Then 'LEFT SIDE CARDS
            Set BingoDiag1 = Range(Chr(32) & "A" & EndRow & ", B" & EndRow - 1 & ", C" & _
                EndRow - 2 & ", D" & EndRow - 3 & ", E" & EndRow - 4 & Chr(32)) 'DIAGONAL UP
            Set BingoDiag2 = Range(Chr(32) & "A" & StartRow & ", B" & StartRow + 1 & ", C" & _
                StartRow + 2 & ", D" & StartRow + 3 & ", E" & StartRow + 4 & Chr(32)) 'DIAGONAL DOWN
        Else: 'RIGHT SIDE CARDS
            Set BingoDiag1 = Range(Chr(32) & "G" & EndRow & ", H" & EndRow - 1 & ", I" & _
                EndRow - 2 & ", J" & EndRow - 3 & ", K" & EndRow - 4 & Chr(32)) 'DIAGONAL UP
            Set BingoDiag2 = Range(Chr(32) & "G" & StartRow & ", H" & StartRow + 1 & ", I" & _
                StartRow + 2 & ", J" & StartRow + 3 & ", K" & StartRow + 4 & Chr(32)) 'DIAGONAL DOWN
        End If
    '==================================================
    'TEST EACH POSSIBLE BINGO RANGE FOR SELECTED CELL
    '==================================================
    'ACROSS
        Bingo = 0
        For Each cell In BingoRow
            If cell.Interior.Color = vbCyan Then
                Bingo = Bingo + 1
            End If
        Next cell
        If Bingo = 5 Then
            BingoRow.Interior.Color = vbGreen
            GoTo winner
        End If
    '--------------------------------------------------
    'DOWN
        Bingo = 0
        For Each cell In BingoCol
            If cell.Interior.Color = vbCyan Then
                Bingo = Bingo + 1
            End If
        Next cell
        If Bingo = 5 Then
            BingoCol.Interior.Color = vbGreen
            GoTo winner
        End If
    '--------------------------------------------------
    'DIAGONAL UP
    Bingo = 0
    For Each cell In BingoDiag1
        If cell.Interior.Color = vbCyan Then
            Bingo = Bingo + 1
        End If
    Next cell
    If Bingo = 5 Then
        BingoDiag1.Interior.Color = vbGreen
        GoTo winner
    End If
    '--------------------------------------------------
    'DIAGONAL DOWN
    Bingo = 0
    For Each cell In BingoDiag2
        If cell.Interior.Color = vbCyan Then
            Bingo = Bingo + 1
        End If
    Next cell
    If Bingo = 5 Then
        BingoDiag2.Interior.Color = vbGreen
        GoTo winner
    End If
    '--------------------------------------------------
    'ALL BINGO RANGES FOR SELECTED CELL ARE FALSE
    CheckWin = False
    Exit Function
    '--------------------------------------------------
    'AT LEAST ONE BINGO RANGE FOR SELECTED CELL IS TRUE
    winner:
        MsgBox "BINGO"
        CheckWin = True
    '--------------------------------------------------
    'CLEANUP
    Set BingoRow = Nothing
    Set BingoCol = Nothing
    Set BingoDiag1 = Nothing
    Set BINGODIAG2 = Nothing
    Set rng = Nothing
    Set cell = Nothing
    End Function
    As the user selects a number, the function checks if there is a winner. If it does detect bingo, the winning row will turn green and a message will popup indicating a winner. The function drops you back off in the Worksheet_SelectionChange event procedure with the variable "win" either True or False.

    HTH,
    Maud

    bingo_win.png
    Attached Files Attached Files
    Last edited by Maudibe; 2016-06-25 at 23:22.

  13. The Following User Says Thank You to Maudibe For This Useful Post:

    Nicole545 (2016-06-26)

  14. #11
    New Lounger
    Join Date
    Nov 2014
    Posts
    21
    Thanks
    16
    Thanked 1 Time in 1 Post
    Maud,

    That was some nudge Your suggestions were great, the code works fantastic. This will be an interoffice Bingo game that will occurs bi-monthly and offers a cash incentive. My goal is to run a master file that picks the numbers and sends them out to the game board copy distributed on the local computers in the departments.

    My next step is to work on the master file then get them to talk to each other. Thank you and Retired Geek for all the help in this project.

    Nicole

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •