Buzzword Bingo
I created a Buzzword Bingo game!
As some of you are aware, Buzzword Bingo (AKA Bullshit Bingo) is a great game to play if you work in an office where you have to attend boring meetings where managers use tired old business cliches constantly. You have to amuse yourself somehow, right? It works just like regular Bingo, except instead of letter/number combinations, you use management cliches. Whoever gets five in a row, wins!
First create a workbook with two sheets named "Table Generator" and "Data". On the "Data" worksheet, create two defined names:
"FullTable", Refers To: =OFFSET(Data!$A$1,1,0,COUNTA(Data!$A:$A)-1,COUNTA(Data!$1:$1))
"TableData", Refers To: =OFFSET(Data!$A$1,1,0,COUNTA(Data!$A:$A)-1,1)
These are dynamic ranges that will automatically expand/contract as needed.
In A1 and B1, create your headers (doesn't matter what you write). The buzzwords should go in column A, starting from A2.
On the "Table Generator" worksheet, highlight A1:E5 and apply some borders. In C3 you can type "Free Space".
Paste the VBA macro code below into the ThisWorkbook code module for the worksheet.
Then, using the Forms Toolbar (View|Toolbars|Forms), create a button and label it "Bingo Card Generator" (or whatever you want). It should be placed somewhere outside the A1:E5 area. Right-click the button and choose "Assign Macro" and select the GenerateRandom() macro you just pasted.
Now select the "Data" worksheet, hide it (Format|Sheet|Hide) and click the button to generate the cards!
Dim i As Integer
Application.ScreenUpdating = False
Sheets("Data").Activate
With Sheets("Data")
.Range("TableData").Offset(0, 1).Formula = "=RAND()"
With .Range("TableData").Offset(0, 1)
.Copy
.PasteSpecial Paste:=xlValues, Operation:=xlNone, skipblanks:=False, _
Transpose:=False
End With
.Range("FullTable").Sort key1:=Cells(1, 2), order1:=xlAscending, _
header:=xlNo, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
Sheets("Table Generator").Activate
With Sheets("Table Generator")
For i = 1 To 5
.Cells(1, i) = Sheets("Data").Range("TableData").Cells(i, 1)
Next i
For i = 1 To 5
.Cells(2, i) = Sheets("Data").Range("TableData").Cells(i + 5, 1)
Next i
.Cells(3, 1) = Sheets("Data").Range("TableData").Cells(11, 1)
.Cells(3, 2) = Sheets("Data").Range("TableData").Cells(12, 1)
.Cells(3, 4) = Sheets("Data").Range("TableData").Cells(13, 1)
.Cells(3, 5) = Sheets("Data").Range("TableData").Cells(14, 1)
For i = 1 To 5
.Cells(4, i) = Sheets("Data").Range("TableData").Cells(i + 14, 1)
Next i
For i = 1 To 5
.Cells(5, i) = Sheets("Data").Range("TableData").Cells(i + 19, 1)
Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
