We have a game like bingo but it uses words and not numbers, thought it
would be great if we could pick the words using excel. I have seen a sheet
that was used to draw numbers for Bingo, see code below, so my question is
can excel pick a random word or phrase without duplicates, and list them on
a sheet and then pick another one?


Here are the details.

The words or phrase are in sheet2 A1:A??? right now it is A50 but could be
more or less, It would need to pick a word from the list when a button is
clicked and put that word in lets say sheet1 A1, the next time it is clicked
it would need to pick a different word from the list and put it in sheet1 A2
an so on....

We would need someway to set the range in VBA if more words are added or
subtracted, ideally it would somehow "know" how many words were in sheet2
column A and adjust to that, don't even know if that is possible.

I have excel 2002

The code below may give you a better understanding of what I want to do.

If you run set_up_sheet it will set the sheet up like it needs to be then
just click on the draw button it see how it works, there is also a macro to
clear the sheet., clear_numbers.

I want it to work like this but to draw words from sheet2 A1 down



Option Explicit

Public Lottery As Variant

Public LotteryIndex As Long

Dim irow As Integer

Dim jcol As Integer

'Based on code by Tom Ogilvy 2002

'[slighty adapted by Max 2005)

Sub Clear_Numbers()

Dim msg, title, response As String

'clears the old numbers in draw mumbers sheet

msg = "Are You Sure You Want To Reset The Numbers ?"

title = "Continue ?"

response = MsgBox(msg, vbYesNo + vbQuestion, title)

If response = vbNo Then

Exit Sub ' Quit the macro

End If

Application.ScreenUpdating = False

Lottery = Shuffle()

LotteryIndex = LBound(Lottery)

irow = 2

jcol = 7

Cells(irow, jcol).CurrentRegion.ClearContents

Range("P3").Value = ""

Range("Q4").Select

Application.ScreenUpdating = True

End Sub


Private Sub InitLottery()

Lottery = Shuffle()

LotteryIndex = LBound(Lottery)

irow = 2

jcol = 7

Cells(irow, jcol).CurrentRegion.ClearContents

Range("P3").Value = ""

Range("Q4").Select

End Sub


Private Sub Draw4()

Dim vArr

Dim iMyNumber As Integer

Dim i As Byte



'draws the numbers



If Not IsArray(Lottery) Then

InitLottery

End If

If LotteryIndex > UBound(Lottery) Then

InitLottery

Cells(irow, jcol).CurrentRegion.ClearContents

End If

Range("P3").Formula = "=RandBetween(1,75)"

For i = 1 To 5

Application.Calculate

Next i

Range("P3").Value = Lottery(LotteryIndex)

Cells(irow, jcol).Value = Range("P3").Value

LotteryIndex = LotteryIndex + 1

irow = irow + 1

If irow = 12 Then

irow = 2

jcol = jcol + 1

End If



End Sub



Function Shuffle()

'

' Algorithm from:

' The Art of Computer Programming: _

' SemiNumerical Algorithms Vol 2, 2nd Ed.

' Donald Knuth

' p. 139

'

'

Dim List() As Long

Dim t As Long

Dim i As Long

Dim j As Long

Dim k As Long

Dim lngTemp As Long

Dim lbnd, ubnd As String

t = 100

lbnd = 1

ubnd = 75

t = ubnd - lbnd + 1

ReDim List(1 To t)

For i = 1 To t

List(i) = i + lbnd - 1

Next

j = t

Randomize

For i = 1 To t

k = Rnd() * j + 1

lngTemp = List(j)

List(j) = List(k)

List(k) = lngTemp

j = j - 1

Next

Shuffle = List

End Function


Sub Set_Up_Sheet()

'used to set the sheet up for demonstrating

Application.ScreenUpdating = False

Columns("G:N").Select

Selection.ColumnWidth = 3

Range("P5:Q8").Select

With Selection

.HorizontalAlignment = xlGeneral

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = True

End With

Selection.UnMerge

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlBottom

.WrapText = False

.Orientation = 0

.AddIndent = False

.IndentLevel = 0

.ShrinkToFit = False

.ReadingOrder = xlContext

.MergeCells = False

End With

Selection.Merge

ActiveCell.FormulaR1C1 = _

"=IF(R[-2]C<1,"""",LOOKUP(R[-2]C,{0;16;31;46;61}," & _

"{""B"";""I"";""N"";""G"";""O""}))&"" ""&R[-2]C"

Range("P9").Select

Range("P5:Q8").Select

With Selection.Font

.Name = "Arial"

.Size = 26

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = False

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

Selection.Font.Bold = True

ActiveSheet.Buttons.Add(90, 32, 150, 30).Select

Selection.OnAction = "Draw4"

With Selection.Characters(Start:=1, Length:=23).Font

..Name = "Arial"

..FontStyle = "Regular"

..Size = 8

..ColorIndex = xlAutomatic

End With

With Selection

.HorizontalAlignment = xlCenter

.VerticalAlignment = xlCenter

.ReadingOrder = xlContext

.Orientation = xlHorizontal

.AutoSize = True

.Placement = xlFreeFloating

.PrintObject = False

Selection.ShapeRange.IncrementLeft 402#

Selection.ShapeRange.IncrementTop -6.75

End With

Selection.Characters.Text = "Draw Number"

Application.Goto Reference:=Range("G1"), Scroll:=True
Range("P1").Select

Application.ScreenUpdating = True

End Sub

Sorry to be so long with this but thought the more details the better.

Thanks in advance

In a general module, put in this code:

Sub ABC()
Dim rng As Range
With Worksheets("Sheet2")
Set rng = .Range("A1", .Range("A1").End(xlDown))

rng.Offset(0, 1).Formula = "=rand()"
rng.Resize(, 2).Sort Key1:=.Range("B1"), _
Header:=xlNo
End With
With Worksheets("Sheet1")
.Range(rng.Address).Formula = "=if(row()<=Sheet2!$C$1," & _
"Offset(Sheet2!$A$1,row()-1,0),"""")"
End With
End Sub

now on Sheet1 put in a commandButton and use this code for the click event:

Private Sub CommandButton1_Click()
Dim rng As Range, rng1 As Range
Set rng = Worksheets("Sheet2").Range("C1")
Set rng1 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)
Debug.Print rng.Value, rng1.Row
If rng >= rng1.Row Or IsEmpty(rng) Then
rng.Value = 0
ABC
Else
rng = rng.Value + 1
End If

End Sub

Now if you click on the button, you should get your first word. Click until
you get all words. When you click again, it will resort the words and start
again.

--
regards,
Tom Ogilvy





"Tim" wrote:

> We have a game like bingo but it uses words and not numbers, thought it
> would be great if we could pick the words using excel. I have seen a sheet
> that was used to draw numbers for Bingo, see code below, so my question is
> can excel pick a random word or phrase without duplicates, and list them on
> a sheet and then pick another one?
>
>
> Here are the details.
>
> The words or phrase are in sheet2 A1:A??? right now it is A50 but could be
> more or less, It would need to pick a word from the list when a button is
> clicked and put that word in lets say sheet1 A1, the next time it is clicked
> it would need to pick a different word from the list and put it in sheet1 A2
> an so on....
>
> We would need someway to set the range in VBA if more words are added or
> subtracted, ideally it would somehow "know" how many words were in sheet2
> column A and adjust to that, don't even know if that is possible.
>
> I have excel 2002
>
> The code below may give you a better understanding of what I want to do.
>
> If you run set_up_sheet it will set the sheet up like it needs to be then
> just click on the draw button it see how it works, there is also a macro to
> clear the sheet., clear_numbers.
>
> I want it to work like this but to draw words from sheet2 A1 down
>
>
>
> Option Explicit
>
> Public Lottery As Variant
>
> Public LotteryIndex As Long
>
> Dim irow As Integer
>
> Dim jcol As Integer
>
> 'Based on code by Tom Ogilvy 2002
>
> '[slighty adapted by Max 2005)
>
> Sub Clear_Numbers()
>
> Dim msg, title, response As String
>
> 'clears the old numbers in draw mumbers sheet
>
> msg = "Are You Sure You Want To Reset The Numbers ?"
>
> title = "Continue ?"
>
> response = MsgBox(msg, vbYesNo + vbQuestion, title)
>
> If response = vbNo Then
>
> Exit Sub ' Quit the macro
>
> End If
>
> Application.ScreenUpdating = False
>
> Lottery = Shuffle()
>
> LotteryIndex = LBound(Lottery)
>
> irow = 2
>
> jcol = 7
>
> Cells(irow, jcol).CurrentRegion.ClearContents
>
> Range("P3").Value = ""
>
> Range("Q4").Select
>
> Application.ScreenUpdating = True
>
> End Sub
>
>
> Private Sub InitLottery()
>
> Lottery = Shuffle()
>
> LotteryIndex = LBound(Lottery)
>
> irow = 2
>
> jcol = 7
>
> Cells(irow, jcol).CurrentRegion.ClearContents
>
> Range("P3").Value = ""
>
> Range("Q4").Select
>
> End Sub
>
>
> Private Sub Draw4()
>
> Dim vArr
>
> Dim iMyNumber As Integer
>
> Dim i As Byte
>
>
>
> 'draws the numbers
>
>
>
> If Not IsArray(Lottery) Then
>
> InitLottery
>
> End If
>
> If LotteryIndex > UBound(Lottery) Then
>
> InitLottery
>
> Cells(irow, jcol).CurrentRegion.ClearContents
>
> End If
>
> Range("P3").Formula = "=RandBetween(1,75)"
>
> For i = 1 To 5
>
> Application.Calculate
>
> Next i
>
> Range("P3").Value = Lottery(LotteryIndex)
>
> Cells(irow, jcol).Value = Range("P3").Value
>
> LotteryIndex = LotteryIndex + 1
>
> irow = irow + 1
>
> If irow = 12 Then
>
> irow = 2
>
> jcol = jcol + 1
>
> End If
>
>
>
> End Sub
>
>
>
> Function Shuffle()
>
> '
>
> ' Algorithm from:
>
> ' The Art of Computer Programming: _
>
> ' SemiNumerical Algorithms Vol 2, 2nd Ed.
>
> ' Donald Knuth
>
> ' p. 139
>
> '
>
> '
>
> Dim List() As Long
>
> Dim t As Long
>
> Dim i As Long
>
> Dim j As Long
>
> Dim k As Long
>
> Dim lngTemp As Long
>
> Dim lbnd, ubnd As String
>
> t = 100
>
> lbnd = 1
>
> ubnd = 75
>
> t = ubnd - lbnd + 1
>
> ReDim List(1 To t)
>
> For i = 1 To t
>
> List(i) = i + lbnd - 1
>
> Next
>
> j = t
>
> Randomize
>
> For i = 1 To t
>
> k = Rnd() * j + 1
>
> lngTemp = List(j)
>
> List(j) = List(k)
>
> List(k) = lngTemp
>
> j = j - 1
>
> Next
>
> Shuffle = List
>
> End Function
>
>
> Sub Set_Up_Sheet()
>
> 'used to set the sheet up for demonstrating
>
> Application.ScreenUpdating = False
>
> Columns("G:N").Select
>
> Selection.ColumnWidth = 3
>
> Range("P5:Q8").Select
>
> With Selection
>
> .HorizontalAlignment = xlGeneral
>
> .VerticalAlignment = xlBottom
>
> .WrapText = False
>
> .Orientation = 0
>
> .AddIndent = False
>
> .IndentLevel = 0
>
> .ShrinkToFit = False
>
> .ReadingOrder = xlContext
>
> .MergeCells = True
>
> End With
>
> Selection.UnMerge
>
> With Selection
>
> .HorizontalAlignment = xlCenter
>
> .VerticalAlignment = xlBottom
>
> .WrapText = False
>
> .Orientation = 0
>
> .AddIndent = False
>
> .IndentLevel = 0
>
> .ShrinkToFit = False
>
> .ReadingOrder = xlContext
>
> .MergeCells = False
>
> End With
>
> Selection.Merge
>
> ActiveCell.FormulaR1C1 = _
>
> "=IF(R[-2]C<1,"""",LOOKUP(R[-2]C,{0;16;31;46;61}," & _
>
> "{""B"";""I"";""N"";""G"";""O""}))&"" ""&R[-2]C"
>
> Range("P9").Select
>

Tom, Thanks, and if I won't to start drawing before the list is complete do
I just clear sheet2 C1?

And if the list number changes should I clear sheet2 column B and sheet1
column A also so the formulas will be put back in right the next time?

Thanks again

Tim

"Tom Ogilvy" <(E-Mail Removed)> wrote in message
news:8901EC2A-A363-4E16-BE5A-(E-Mail Removed)...
> In a general module, put in this code:
>
> Sub ABC()
> Dim rng As Range
> With Worksheets("Sheet2")
> Set rng = .Range("A1", .Range("A1").End(xlDown))
>
> rng.Offset(0, 1).Formula = "=rand()"
> rng.Resize(, 2).Sort Key1:=.Range("B1"), _
> Header:=xlNo
> End With
> With Worksheets("Sheet1")
> .Range(rng.Address).Formula = "=if(row()<=Sheet2!$C$1," & _
> "Offset(Sheet2!$A$1,row()-1,0),"""")"
> End With
> End Sub
>
> now on Sheet1 put in a commandButton and use this code for the click
event:
>
> Private Sub CommandButton1_Click()
> Dim rng As Range, rng1 As Range
> Set rng = Worksheets("Sheet2").Range("C1")
> Set rng1 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)
> Debug.Print rng.Value, rng1.Row
> If rng >= rng1.Row Or IsEmpty(rng) Then
> rng.Value = 0
> ABC
> Else
> rng = rng.Value + 1
> End If
>
> End Sub
>
> Now if you click on the button, you should get your first word. Click
until
> you get all words. When you click again, it will resort the words and
start
> again.
>
> --
> regards,
> Tom Ogilvy
>
>
>
>
>
> "Tim" wrote:
>
> > We have a game like bingo but it uses words and not numbers, thought it
> > would be great if we could pick the words using excel. I have seen a
sheet
> > that was used to draw numbers for Bingo, see code below, so my question
is
> > can excel pick a random word or phrase without duplicates, and list them
on
> > a sheet and then pick another one?
> >
> >
> > Here are the details.
> >
> > The words or phrase are in sheet2 A1:A??? right now it is A50 but could
be
> > more or less, It would need to pick a word from the list when a button
is
> > clicked and put that word in lets say sheet1 A1, the next time it is
clicked
> > it would need to pick a different word from the list and put it in
sheet1 A2
> > an so on....
> >
> > We would need someway to set the range in VBA if more words are added or
> > subtracted, ideally it would somehow "know" how many words were in
sheet2
> > column A and adjust to that, don't even know if that is possible.
> >
> > I have excel 2002
> >
> > The code below may give you a better understanding of what I want to
do.
> >
> > If you run set_up_sheet it will set the sheet up like it needs to be
then
> > just click on the draw button it see how it works, there is also a macro
to
> > clear the sheet., clear_numbers.
> >
> > I want it to work like this but to draw words from sheet2 A1 down
> >
> >
> >
> > Option Explicit
> >
> > Public Lottery As Variant
> >
> > Public LotteryIndex As Long
> >
> > Dim irow As Integer
> >
> > Dim jcol As Integer
> >
> > 'Based on code by Tom Ogilvy 2002
> >
> > '[slighty adapted by Max 2005)
> >
> > Sub Clear_Numbers()
> >
> > Dim msg, title, response As String
> >
> > 'clears the old numbers in draw mumbers sheet
> >
> > msg = "Are You Sure You Want To Reset The Numbers ?"
> >
> > title = "Continue ?"
> >
> > response = MsgBox(msg, vbYesNo + vbQuestion, title)
> >
> > If response = vbNo Then
> >
> > Exit Sub ' Quit the macro
> >
> > End If
> >
> > Application.ScreenUpdating = False
> >
> > Lottery = Shuffle()
> >
> > LotteryIndex = LBound(Lottery)
> >
> > irow = 2
> >
> > jcol = 7
> >
> > Cells(irow, jcol).CurrentRegion.ClearContents
> >
> > Range("P3").Value = ""
> >
> > Range("Q4").Select
> >
> > Application.ScreenUpdating = True
> >
> > End Sub
> >
> >
> > Private Sub InitLottery()
> >
> > Lottery = Shuffle()
> >
> > LotteryIndex = LBound(Lottery)
> >
> > irow = 2
> >
> > jcol = 7
> >
> > Cells(irow, jcol).CurrentRegion.ClearContents
> >
> > Range("P3").Value = ""
> >
> > Range("Q4").Select
> >
> > End Sub
> >
> >
> > Private Sub Draw4()
> >
> > Dim vArr
> >
> > Dim iMyNumber As Integer
> >
> > Dim i As Byte
> >
> >
> >
> > 'draws the numbers
> >
> >
> >
> > If Not IsArray(Lottery) Then
> >
> > InitLottery
> >
> > End If
> >
> > If LotteryIndex > UBound(Lottery) Then
> >
> > InitLottery
> >
> > Cells(irow, jcol).CurrentRegion.ClearContents
> >
> > End If
> >
> > Range("P3").Formula = "=RandBetween(1,75)"
> >
> > For i = 1 To 5
> >
> > Application.Calculate
> >
> > Next i
> >
> > Range("P3").Value = Lottery(LotteryIndex)
> >
> > Cells(irow, jcol).Value = Range("P3").Value
> >
> > LotteryIndex = LotteryIndex + 1
> >
> > irow = irow + 1
> >
> > If irow = 12 Then
> >
> > irow = 2
> >
> > jcol = jcol + 1
> >
> > End If
> >
> >
> >
> > End Sub
> >
> >
> >
> > Function Shuffle()
> >
> > '
> >
> > ' Algorithm from:
> >
> > ' The Art of Computer Programming: _
> >
> > ' SemiNumerical Algorithms Vol 2, 2nd Ed.
> >
> > ' Donald Knuth
> >
> > ' p. 139
> >
> > '
> >
> > '
> >
> > Dim List() As Long
> >
> > Dim t As Long
> >
> > Dim i As Long
> >
> > Dim j As Long
> >
> > Dim k As Long
> >
> > Dim lngTemp As Long
> >
> > Dim lbnd, ubnd As String
> >
> > t = 100
> >
> > lbnd = 1
> >
> > ubnd = 75
> >
> > t = ubnd - lbnd + 1
> >
> > ReDim List(1 To t)
> >
> > For i = 1 To t
> >
> > List(i) = i + lbnd - 1
> >
> > Next
> >
> > j = t
> >
> > Randomize
> >
> > For i = 1 To t
> >
> > k = Rnd() * j + 1
> >
> > lngTemp = List(j)
> >
> > List(j) = List(k)
> >
> > List(k) = lngTemp
> >
> > j = j - 1
> >
> > Next
> >
> > Shuffle = List
> >
> > End Function
> >
> >
> > Sub Set_Up_Sheet()
> >
> > 'used to set the sheet up for demonstrating
> >
> > Application.ScreenUpdating = False
> >
> > Columns("G:N").Select
> >
> > Selection.ColumnWidth = 3
> >
> > Range("P5:Q8").Select
> >
> > With Selection
> >
> > .HorizontalAlignment = xlGeneral
> >
> > .VerticalAlignment = xlBottom
> >
> > .WrapText = False
> >
> > .Orientation = 0
> >
> > .AddIndent = False
> >
> > .IndentLevel = 0
> >
> > .ShrinkToFit = False
> >
> > .ReadingOrder = xlContext
> >
> > .MergeCells = True
> >
> > End With
> >
> > Selection.UnMerge
> >
> > With Selection
> >
> > .HorizontalAlignment = xlCenter
> >
> > .VerticalAlignment = xlBottom
> >
> > .WrapText = False
> >
> > .Orientation = 0
> >
> > .AddIndent = False
> >
> > .IndentLevel = 0
> >
> > .ShrinkToFit = False
> >
> > .ReadingOrder = xlContext
> >
> > .MergeCells = False
> >
> > End With
> >
> > Selection.Merge
> >
> > ActiveCell.FormulaR1C1 = _
> >
> > "=IF(R[-2]C<1,"""",LOOKUP(R[-2]C,{0;16;31;46;61}," & _
> >
> > "{""B"";""I"";""N"";""G"";""O""}))&"" ""&R[-2]C"
> >
> > Range("P9").Select
> >

Yes, just clear Sheet2!C1. If that is blank when you click the button, it
resizes the list and reenters the formulas.


Each time it initializes, it rebuilds the formulas, but if the previous list
was longer than the current list, those formulas beyond the current list
size would remain - but they should still appear blank. I don't see any
reason to clear them. In the same situation, I don't think residual
formulas in column B of Sheet2 should cause any problem.

--
Regards,
Tom Ogilvy





"Tim" <(E-Mail Removed)> wrote in message
news:%23vlCOoE$(E-Mail Removed)...
> Tom, Thanks, and if I won't to start drawing before the list is complete
> do
> I just clear sheet2 C1?
>
> And if the list number changes should I clear sheet2 column B and sheet1
> column A also so the formulas will be put back in right the next time?
>
> Thanks again
>
> Tim
>
> "Tom Ogilvy" <(E-Mail Removed)> wrote in message
> news:8901EC2A-A363-4E16-BE5A-(E-Mail Removed)...
>> In a general module, put in this code:
>>
>> Sub ABC()
>> Dim rng As Range
>> With Worksheets("Sheet2")
>> Set rng = .Range("A1", .Range("A1").End(xlDown))
>>
>> rng.Offset(0, 1).Formula = "=rand()"
>> rng.Resize(, 2).Sort Key1:=.Range("B1"), _
>> Header:=xlNo
>> End With
>> With Worksheets("Sheet1")
>> .Range(rng.Address).Formula = "=if(row()<=Sheet2!$C$1," & _
>> "Offset(Sheet2!$A$1,row()-1,0),"""")"
>> End With
>> End Sub
>>
>> now on Sheet1 put in a commandButton and use this code for the click
> event:
>>
>> Private Sub CommandButton1_Click()
>> Dim rng As Range, rng1 As Range
>> Set rng = Worksheets("Sheet2").Range("C1")
>> Set rng1 = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)
>> Debug.Print rng.Value, rng1.Row
>> If rng >= rng1.Row Or IsEmpty(rng) Then
>> rng.Value = 0
>> ABC
>> Else
>> rng = rng.Value + 1
>> End If
>>
>> End Sub
>>
>> Now if you click on the button, you should get your first word. Click
> until
>> you get all words. When you click again, it will resort the words and
> start
>> again.
>>
>> --
>> regards,
>> Tom Ogilvy
>>
>>
>>
>>
>>
>> "Tim" wrote:
>>
>> > We have a game like bingo but it uses words and not numbers, thought it
>> > would be great if we could pick the words using excel. I have seen a
> sheet
>> > that was used to draw numbers for Bingo, see code below, so my question
> is
>> > can excel pick a random word or phrase without duplicates, and list
>> > them
> on
>> > a sheet and then pick another one?
>> >
>> >
>> > Here are the details.
>> >
>> > The words or phrase are in sheet2 A1:A??? right now it is A50 but
>> > could
> be
>> > more or less, It would need to pick a word from the list when a button
> is
>> > clicked and put that word in lets say sheet1 A1, the next time it is
> clicked
>> > it would need to pick a different word from the list and put it in
> sheet1 A2
>> > an so on....
>> >
>> > We would need someway to set the range in VBA if more words are added
>> > or
>> > subtracted, ideally it would somehow "know" how many words were in
> sheet2
>> > column A and adjust to that, don't even know if that is possible.
>> >
>> > I have excel 2002
>> >
>> > The code below may give you a better understanding of what I want to
> do.
>> >
>> > If you run set_up_sheet it will set the sheet up like it needs to be
> then
>> > just click on the draw button it see how it works, there is also a
>> > macro
> to
>> > clear the sheet., clear_numbers.
>> >
>> > I want it to work like this but to draw words from sheet2 A1 down
>> >
>> >
>> >
>> > Option Explicit
>> >
>> > Public Lottery As Variant
>> >
>> > Public LotteryIndex As Long
>> >
>> > Dim irow As Integer
>> >
>> > Dim jcol As Integer
>> >
>> > 'Based on code by Tom Ogilvy 2002
>> >
>> > '[slighty adapted by Max 2005)
>> >
>> > Sub Clear_Numbers()
>> >
>> > Dim msg, title, response As String
>> >
>> > 'clears the old numbers in draw mumbers sheet
>> >
>> > msg = "Are You Sure You Want To Reset The Numbers ?"
>> >
>> > title = "Continue ?"
>> >
>> > response = MsgBox(msg, vbYesNo + vbQuestion, title)
>> >
>> > If response = vbNo Then
>> >
>> > Exit Sub ' Quit the macro
>> >
>> > End If
>> >
>> > Application.ScreenUpdating = False
>> >
>> > Lottery = Shuffle()
>> >
>> > LotteryIndex = LBound(Lottery)
>> >
>> > irow = 2
>> >
>> > jcol = 7
>> >
>> > Cells(irow, jcol).CurrentRegion.ClearContents
>> >
>> > Range("P3").Value = ""
>> >
>> > Range("Q4").Select
>> >
>> > Application.ScreenUpdating = True
>> >
>> > End Sub
>> >
>> >
>> > Private Sub InitLottery()
>> >
>> > Lottery = Shuffle()
>> >
>> > LotteryIndex = LBound(Lottery)
>> >
>> > irow = 2
>> >
>> > jcol = 7
>> >
>> > Cells(irow, jcol).CurrentRegion.ClearContents
>> >
>> > Range("P3").Value = ""
>> >
>> > Range("Q4").Select
>> >
>> > End Sub
>> >
>> >
>> > Private Sub Draw4()
>> >
>> > Dim vArr
>> >
>> > Dim iMyNumber As Integer
>> >
>> > Dim i As Byte
>> >
>> >
>> >
>> > 'draws the numbers
>> >
>> >
>> >
>> > If Not IsArray(Lottery) Then
>> >
>> > InitLottery
>> >
>> > End If
>> >
>> > If LotteryIndex > UBound(Lottery) Then
>> >
>> > InitLottery
>> >
>> > Cells(irow, jcol).CurrentRegion.ClearContents
>> >
>> > End If
>> >
>> > Range("P3").Formula = "=RandBetween(1,75)"
>> >
>> > For i = 1 To 5
>> >
>> > Application.Calculate
>> >
>> > Next i
>> >
>> > Range("P3").Value = Lottery(LotteryIndex)
>> >
>> > Cells(irow, jcol).Value = Range("P3").Value
>> >
>> > LotteryIndex = LotteryIndex + 1
>> >
>> > irow = irow + 1
>> >
>> > If irow = 12 Then
>> >
>> > irow = 2
>> >
>> > jcol = jcol + 1
>> >
>> > End If
>> >
>> >
>> >
>> > End Sub
>> >
>> >
>> >
>> > Function Shuffle()
>> >
>> > '
>> >
>> > ' Algorithm from:
>> >
>> > ' The Art of Computer Programming: _
>> >
>> > ' SemiNumerical Algorithms Vol 2, 2nd Ed.
>> >
>> > ' Donald Knuth
>> >
>> > ' p. 139
>> >
>> > '
>> >
>> > '
>> >
>> > Dim List() As Long
>> >
>> > Dim t As Long
>> >
>> > Dim i As Long
>> >
>> > Dim j As Long
>> >
>> > Dim k As Long
>> >
>> > Dim lngTemp As Long
>> >
>> > Dim lbnd, ubnd As String
>> >
>> > t = 100
>> >
>> > lbnd = 1
>> >
>> > ubnd = 75
>> >
>> > t = ubnd - lbnd + 1
>> >
>> > ReDim List(1 To t)
>> >
>> > For i = 1 To t
>> >
>> > List(i) = i + lbnd - 1
>> >
>> > Next
>> >
>> > j = t
>> >
>> > Randomize
>> >
>> > For i = 1 To t
>> >
>> > k = Rnd() * j + 1
>> >
>> > lngTemp = List(j)
>> >
>> > List(j) = List(k)
>> >
>> > List(k) = lngTemp
>> >
>> > j = j - 1
>> >
>> > Next
>> >
>> > Shuffle = List
>> >
>> > End Function
>> >
>> >
>> > Sub Set_Up_Sheet()
>> >
>> > 'used to set the sheet up for demonstrating
>> >
>> > Application.ScreenUpdating = False
>> >
>> > Columns("G:N").Select
>> >
>> > Selection.ColumnWidth = 3
>> >
>> > Range("P5:Q8").Select
>> >
>> > With Selection
>> >
>> > .HorizontalAlignment = xlGeneral
>> >
>> > .VerticalAlignment = xlBottom
>> >
>> > .WrapText = False
>> >
>> > .Orientation = 0
>> >
>> > .AddIndent = False
>> >
>> > .IndentLevel = 0
>> >
>> > .ShrinkToFit = False
>> >
>> > .ReadingOrder = xlContext
>> >
>> > .MergeCells = True
>> >
>> > End With
>> >
>> > Selection.UnMerge
>> >
>> > With Selection
>> >
>> > .HorizontalAlignment = xlCenter
>> >
>> > .VerticalAlignment = xlBottom
>> >
>> > .WrapText = False
>> >
>> > .Orientation = 0
>> >
>> > .AddIndent = False
>> >
>> > .IndentLevel = 0
>> >
>> > .ShrinkToFit = False
>> >
>> > .ReadingOrder = xlContext
>> >
>> > .MergeCells = False
>> >
>> > End With
>> >
>> > Selection.Merge
>> >
>> > ActiveCell.FormulaR1C1 = _
>> >
>> > "=IF(R[-2]C<1,"""",LOOKUP(R[-2]C,{0;16;31;46;61}," & _
>> >
>> > "{""B"";""I"";""N"";""G"";""O""}))&"" ""&R[-2]C"
>> >
>> > Range("P9").Select
>> >
>
>