View Single Post
  #6   Report Post  
Jim Cone
 
Posts: n/a
Default

To person with two names
Give the following code a try...
'----------------------------------------------------------------
Option Explicit

Sub BibleBingo()
'Jim Cone - December 17, 2004
'Creates two bingo type cards using book names from the Bible.
'Assigns names of books from the Bible, at random, to the
'first two worksheets in the active workbook.
'The first sheet will have old testament book names and
'the second sheet will have new testament names.
'The worksheets must be manually formatted in
'cells "C12:G16" to look like bingo cards.

Dim varOldTest As Variant
Dim varNewTest As Variant
Dim i As Long
Dim j As Long
Dim k As Long
Dim lngNum As Long
Dim lngIndex As Long
Dim arrNums() As Long
Dim arrBooks() As String

varOldTest = Array("Genesis", "Exodus", "Leviticus", "Numbers", _
"Deuteronomy", "Joshua", "Judges", "Ruth1", "Samuel2", _
"Samuel1", "Kings2", "Kings1", "Chronicles2", "Chronicles", _
"Ezra", "Nehemiah", "Esther", "Job", "Psalms", "Proverbs", _
"Ecclesiastes", "Song of Solomon", "Isaiah", "Jeremiah", _
"Lamentations", "Ezekiel", "Daniel", "Hosea", "Joel", _
"Amos", "Obadiah", "Jonah", "Micah", "Nahum", "Habakkuk", _
"Zephaniah", "Haggai", "Zechariah", "Malachi") '39

varNewTest = Array("Matthew", "Mark", "Luke", "John", "Acts", _
"Romans1", "Corinthians2", "Corinthians", "Galatians", _
"Ephesians", "Philippians", "Colossians1", _
"Thessalonians2", "Thessalonians1", "Timothy2", _
"Timothy", "Titus", "Philemon", "Hebrews", "James1", _
"Peter2", "Peter1", "John2", "John3", "John", "Jude", _
"Revelation") '27

For lngIndex = 1 To 2
If lngIndex = 1 Then lngNum = 38 Else lngNum = 26
ReDim arrNums(0 To lngNum)
ReDim arrBooks(1 To 5, 1 To 5)
For i = 1 To 5
For j = 1 To 5
Do
Randomize (Right(Timer, 2) * i)
'Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
k = Int((lngNum + 1) * Rnd)
'prevents duplicates
If arrNums(k) < 999 Then
If lngIndex = 1 Then
arrBooks(i, j) = varOldTest(k)
arrNums(k) = 999
Else
arrBooks(i, j) = varNewTest(k)
arrNums(k) = 999
End If
End If
Loop Until arrBooks(i, j) < vbNullString
Next 'j
Next 'i
arrBooks(3, 3) = "FREE"
'put names on worksheets
Worksheets(lngIndex).Range("C12:G16").Value = arrBooks()
Next 'lngIndex
End Sub
'------------------------------------------------------------------------

Jim Cone
San Francisco, CA

"BArtneedsHELP" wrote in message
...
I want to create two excel sheets. One to print OT the other to print NT. How
do I program a variable to give me a 5 by 5 print out of 27 or 39 names
(books of the bible) leaving the center blank. So I can print out BINGO
sheets. Having everything centered. And the size of the boxes equal.