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