Random Value...

  • Thread starter Thread starter Duncan
  • Start date Start date
D

Duncan

Hi all,

I know this has been covered all over with various topics but im not
sure that it fits my purpose, basically I want to select one of my 600
cells to put the value in a textbox, and randomly. But I dont want any
duplicates, so want to cycle through my values at random without
showing the same one twice, and when/if all 600 have been displayed
just to start again from the beginning.

at the moment I have:

Private Sub Thons_Click()
Randomize
Dim MyValue, MyString
A:
MyValue = Int((600 * Rnd) + 1)
MyString = Range("E" & MyValue)
If MyString = "" Then GoTo A
tbMessage.Text = MyString
End Sub

I have to put the Goto A in there because some cells in the column are
blank, and dont want to display those.

Any ideas how I can achieve this without duplicates popping up? mainly
because sometimes the first 10 displayed repeat and then you are not
sure if you have seen them all.

Any help would be much appreciated.

Many thanks

Duncan
 
is this all within one session of using a workbook or do you want to maintain
this rotation across multiple openings. Are the values in the source column
static - they will not change?

One method that would support this would be to add a hidden sheet, copy all
your values to column 1. Then in column 2 of that sheet put in the formula
=rnd(), sort on that column and delete blanks.

With Worksheets(5).Range("B1:B600")
.Formula = "=rnd()"
.offset(0,-1).Resize(600,2).sort key1:=.Range("B1"), _
Header:=xlNo
on Error Resume Next
set rng = .offset(0,-1).SpecialCells(xlBlanks)
On Error goto 0
if not rng is nothing then
rng.Entirerow.Delete
end if
End with

Now just put a value in column B to indicate which value you will use. when
you retrieve that value, move the mark to the next cell.
 
Tom,

I must admit im finding it hard to understand how to implement your
suggested solution, I will try to explain a little better then maybe in
that time I will have understood what you have written.

This is a simple program I made quickly just to cycle through 'random
sentances'. I put a column of sentances in (a column for each button,
so column A is for the button that brings up random quotes) and then
just want to cycle through these by clicking the button over and over
to display the sentance in the textbox on the form.

I dont really want to have to manually do any sorting or anything,
would just like it to be automated and the only manual touching of the
spreadsheet if i want to add some sentances in to my list.

I am going to read what you have written again and try to understand
(brain real slow today) but I would be most gratefull if you knew how
this could be done without anything manual going on. Really just want
MyValue to not come up the same twice when form is running, when form
closed and opened again it doesnt matter if it goes back to the start
its only for when the form loads up from then onwards until its closed.

Many thanks

Duncan
 
Tom,

Still cannot fathom out how to get this to do what I want, but I should
also mention that some columns wont have blank cells on the same line,
so cannot delete entire row or it will wipe out the other data as well.

Duncan
 
====================
In the userform module:
====================

Option Explicit
Public List As Variant
Public ListIndex As Long

Private Sub CommandButton1_Click()
Static rw As Long

TextBox1.Value = List(ListIndex)
rw = rw + 1
With Worksheets("Sheet1")
.Cells(rw, "C").Value = List(ListIndex)
End With
ListIndex = ListIndex + 1
If ListIndex > UBound(List, 1) Then
ListIndex = LBound(List, 1)
End If
End Sub

Private Sub UserForm_Initialize()
Dim rng As Range
Dim j As Long, i As Long
With Worksheets("sheet1")
Set rng = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
List = rng.Value
j = LBound(List, 1) - 1
For i = LBound(List, 1) To UBound(List, 1)
If Len(Trim(List(i, 1))) <> 0 Then
j = j + 1
Debug.Print j, UBound(List, 1)
List(j, 1) = List(i, 1)
If i > j Then List(i, 1) = Empty
End If
Next
List = Application.Transpose(List)
ReDim Preserve List(1 To j)
Shuffle List
ListIndex = LBound(List)
End Sub

====================
in a general module:
====================

Sub Shuffle(List As Variant)
'
' Algorithm from:
' The Art of Computer Programming: _
' SemiNumerical Algorithms Vol 2, 2nd Ed.
' Donald Knuth
' p. 139 [Algorithm P]
'
'
Dim t As Long, j As Long, k As Long
t = UBound(List, 1)
j = t
Randomize
For i = 1 To t
k = Int(Rnd() * j + 1)
lngTemp = List(j)
List(j) = List(k)
List(k) = lngTemp
j = j - 1
Next
End Sub


If you have multiple separate lists, you would need to incorporate
additional code to handle them.
 
Tom,

You are a complete genius. Many Thanks

I am trying to get to grips with it so that I can incorporate my other
columns for other buttons, I might just have a sheet for each button
and just copy and paste the code and change the sheet name. (that
should work I think....)

Many thanks again

Duncan


Tom said:
====================
In the userform module:
====================

Option Explicit
Public List As Variant
Public ListIndex As Long

Private Sub CommandButton1_Click()
Static rw As Long

TextBox1.Value = List(ListIndex)
rw = rw + 1
With Worksheets("Sheet1")
.Cells(rw, "C").Value = List(ListIndex)
End With
ListIndex = ListIndex + 1
If ListIndex > UBound(List, 1) Then
ListIndex = LBound(List, 1)
End If
End Sub

Private Sub UserForm_Initialize()
Dim rng As Range
Dim j As Long, i As Long
With Worksheets("sheet1")
Set rng = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
List = rng.Value
j = LBound(List, 1) - 1
For i = LBound(List, 1) To UBound(List, 1)
If Len(Trim(List(i, 1))) <> 0 Then
j = j + 1
Debug.Print j, UBound(List, 1)
List(j, 1) = List(i, 1)
If i > j Then List(i, 1) = Empty
End If
Next
List = Application.Transpose(List)
ReDim Preserve List(1 To j)
Shuffle List
ListIndex = LBound(List)
End Sub

====================
in a general module:
====================

Sub Shuffle(List As Variant)
'
' Algorithm from:
' The Art of Computer Programming: _
' SemiNumerical Algorithms Vol 2, 2nd Ed.
' Donald Knuth
' p. 139 [Algorithm P]
'
'
Dim t As Long, j As Long, k As Long
t = UBound(List, 1)
j = t
Randomize
For i = 1 To t
k = Int(Rnd() * j + 1)
lngTemp = List(j)
List(j) = List(k)
List(k) = lngTemp
j = j - 1
Next
End Sub


If you have multiple separate lists, you would need to incorporate
additional code to handle them.

--
regards,
Tom Ogilvy


Duncan said:
Tom,

Still cannot fathom out how to get this to do what I want, but I should
also mention that some columns wont have blank cells on the same line,
so cannot delete entire row or it will wipe out the other data as well.

Duncan
Click to expand...
Click to expand...
 
Back
Top