Specialized "Bingo" Card

I created something that did exactly this shortly before I quit my last job. I'm not sure if I saved it or not, but I'll see if I can locate it and get it to you. Mine was for a 9 by 9 grid, but I'm sure you could adapt it

How about something like this?

One one sheet you have a 5 by 5 grid of = Rand()
On the other sheet you have the list of baby stuff, and the following formula

=INDEX($G$2:$G$26,RANK('Random Seeds'!A1,'Random Seeds'!$A$1:$E$5))

[Edit] Here's a link to the file itself
http://www.box.net/public/xkbvztbxsd

Chain this code into one sub, changing the last line to the location of the card/cell. You build the list of possible Cell values and point the code to your list. Then use the three lines of code to update a cell location with the random value. Use a copy of these three lines of code for each cell, one after another, just changing the last line, the location.



Dim myName
Dim mySelect As Variant

'Select the list.
Sheets("List").Select

'Note: The 25 below = the ending ROW of your names list.
' The 6 below = the starting ROW of your names list.
mySelect = Int((25 * Rnd) + 6)

'Note: The "B" below is the column where your names list is.
myName = Range("B" & mySelect)

'Put the answer in cell "D6."
Worksheets("List").Range("D6") = myName

PA HS Teacher,

Your answer looks promising. I will have to take a look at it when I get home (I can't download files here at work).

Joe Was,
I used your code to come up with this:
The only problem is that it allows duplicates, which aren't allowed on Bingo cards.

I tested this it works, note the list requirements in the code:

Note: You may want to format range D1:H5 to something that looks like the cells on a card, and set Wrap Text on, with Horizontal/Vertical Alignment set to center.

Sub BabyBingo()
'Standard module code, like: Module1.
Dim i&, j&, myBot&, myCnt&
Dim myName$
Dim mySelect As Variant

'Please build your list of items in
'Column "A" starting in Cell: A6.
'You must have at least 25 items in the list [to Row 31] or more!

myBot = ActiveSheet.Range("A65536").End(xlUp).Row

myCnt = ActiveSheet.Range("A6:A" & myBot).Count

If myCnt <= 25 Then
MsgBox "Your list of items does not contain at least 25 items?)"
Exit Sub
End If

ActiveSheet.Range("A6:A" & myBot).Copy _
Destination:=ActiveSheet.Range("B6")

For i = 4 To 8
For j = 1 To 5

myNonBlnk:
mySelect = Int((31 * Rnd) + 6)

myName = ActiveSheet.Range("B" & mySelect)

If myName = "" Then GoTo myNonBlnk

ActiveSheet.Cells(j, i) = myName
ActiveSheet.Range("B" & mySelect).ClearContents
Next j
Next i

ActiveSheet.Range("B6:B" & myBot).ClearContents
ActiveSheet.Range("D1").Select
End Sub

Joe,

Thanks. With one minor edit, I got it to work out.

I needed to change:
If myCnt <= 25 Then
to
If myCnt < 25 Then
as otherwise it doesn't run if there are exactly 25 items.

Thanks when I tested it I inadvertently added 26 items to my list and adjusted the code without thinking. Glad it worked out for you.

But, I cannot work out how it will be used?
Is their going to be some game to determine who purchases what?
Or, some drawing, wouldn't the cells also need some numbers or coordinates, if some drawing system is to be used?

Funny, I asked my wife the same question...

Everyone at the baby shower gets a different Bingo card. I guess the cards are filled with items that the mother-to-be has registered for. As she is opening her gifts, the guests fill out their cards. The first one to get "Bingo" gets some sort of prize.

If they really wanted to make it fun, they should let the winner pick the name of the baby!