Bingo word boards random

reppert25

New Member
Joined
Sep 26, 2017
Messages
4
Need some help figuring out how to either make up equations or vba code to figure out 1200 combinations of 43 sets of words.
What I am trying to do is merge the data into indesign on a bingo boards, 25 spaces and the center is common, so 24 boxes.
I need 24 columns and each row would be made up of a combination of the 43 sets of words below.
None of the rows can be the same. So pretty much I want the first cell to pick a random item from the list, take it away from the list, then pick another, up to the 24th cell.
Then the next row would do the same with the same 43 sets but when its done if it matches a row above it would start over again until it had 24 cells that have not shown up yet.
I would like to do this for 1200 cards but that could change to x amount less or more.
Thanks for any help.

Here is the list:

NumberList of words
1Polar Bear
2Mom and Cub
3Bears Sparring
4Red Fox
5Arctic Fox
6Caribou
7Buggy Love
8Arctic Hare
9Common Raven
10Ermine
11Marten
12Weasel
13Willow Ptarmigan
14Gyrfalcon
15Peregrine Falcon
16Snow Bunting
17Bald Eagle
18Muskrat
19Rock Ptarmigan
20Gray Jay
21Moose
22Snowy Owl
23Polar Bear Tracks
24Willows
25Flag Tree
26Lemmings
27Tundra Buggy Lodge
28Churchill Sunset
29Hare Tracks
30Fox Tracks
31Greywackye Rock
32Hudson Bay
33Fireweed
34Ithaca
35Buggy One
36Kelp/Seaweed
37Snow
38Grease ice
39Sun Dogs
40No Pants Lake
41Lunch Point Inukshuk
42Glacial Esker
43Fox Den

<colgroup><col><col></colgroup><tbody>
</tbody>
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Welcome to the MrExcel board.

Open a new workbook. On Sheet1, put your list, with the numbers in column A, and the names in column B. Add Sheet2. Press Alt-F11 to open the VBA editor. From the menu click Insert > Module. Paste the following code into the sheet that opens:

Code:
Sub Bingo()
Dim c As Long, ub As Long, words As Variant, words2 As Variant, i As Long, k As String, MyDict As Object
Dim outcol(), cards As Variant

    c = InputBox("How many cards do you want?")
    Sheets("Sheet2").Cells.ClearContents
    
    If c < 1 Then Exit Sub
    
    words = Sheets("Sheet1").Range("B2:B44").Value
    Set MyDict = CreateObject("Scripting.Dictionary")
    
    While MyDict.Count < c
        words2 = words
        ub = UBound(words)
        k = ""
        For i = 1 To 24
            x = Int(Rnd() * ub + 1)
            k = k & "," & words2(x, 1)
            words2(x, 1) = words2(ub, 1)
            ub = ub - 1
        Next i
        MyDict(k) = 1
    Wend
    ReDim outcol(1 To c, 1 To 1)
    cards = MyDict.keys
    For i = 1 To c
        outcol(i, 1) = Mid(cards(i - 1), 2)
    Next i
    Sheets("Sheet2").Range("A1").Resize(MyDict.Count).Value = outcol
    
    Sheets("Sheet2").Range("A:A").TextToColumns Destination:=Sheets("Sheet2").Range("A1"), _
        DataType:=xlDelimited, Comma:=True
            
End Sub
Press Alt-Q to close the editor. In Excel, press Alt-F8 to open the macro selector, choose Bingo and click Run.

Let me know how it works.
 
Upvote 0
Thanks alot seems to be working perfectly. I went through with a formula and conditional formatting to see if any rows repeated nothing. Can you let me know where in the code it stops it from having repeating rows. I have a fairly good idea what is going on with the code but the not repeating has me stumped.
 
Upvote 0
Thanks alot seems to be working perfectly. I went through with a formula and conditional formatting to see if any rows repeated nothing. Can you let me know where in the code it stops it from having repeating rows. I have a fairly good idea what is going on with the code but the not repeating has me stumped.

Me ... or EricW ?
 
Upvote 0
Sure! This pretty much is the entire duplicate key checker:

Code:
MyDict(k) = 1
Dictionary objects have some pretty nice features. In that line, you specify the dictionary (MyDict), the key (k), and the value you want to set the item to (1). The key is a string comprised of a random selection of words, calculated in the loop above it. If that line is executed and the key does not already exist in the dictionary, that line will create the key and set the item value. If the key already exists, it sets the value to 1 (again).

But of course, if a duplicate is found, the MyDict.Count value will not increase. That's why I used a "While MyDict.Count < c" loop instead of just a "For i = 1 to c" loop.

Another way to add a key to the dictionary is:

Code:
MyDict.Add k,1
If you try to add it this way, you'll get an error if you try to add a duplicate key. So you can check first by using
Code:
If MyDict.Exists(k) Then
but that takes some extra code.

Make sense?
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,255
Members
448,556
Latest member
peterhess2002

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