Randomize Program Help

[Mike]

Good Morning all,

I have been building a little Excel program that goes
through a list of account numbers and randomly selects
accounts to check on. The way I have it set up is with a
textbox that records the percentage of accounts that you
want to have randomly selected (ie 15% of 137 accounts).
It then dumps the random list on a second sheet.

The problem I'm having is that the way I have it set up,
the randomizer sometimes grabs the same account number.
Please see the code for the macro below and if anybody has
any ideas on how to "record" which accounts have already
been selected for the test, please let me know.

Thanks in advance for your help,

Mike

Private Sub cmdGetRandom_Click()
Dim i As Integer
Dim j As Integer
Dim MyValue As Integer
Dim Per As Double
Dim Sample As Long
Dim Account As String
Dim SampleRows As Integer
SampleRows = 3
Per = txtPerc.Value
j = 1

If txtPerc = "" Then
MsgBox "Please type the percentage you require for your
sample in the TextBox provided", vbOKOnly
Exit Sub
End If

With Sheets("Samples")
.Range("A3:A5000").Clear
End With
For Each cell In Range("A5:A" & Range("A" & Rows.Count).End
(xlUp).Row)
i = i + 1
Next
Sample = i * (Per / 100)

Do While j <> Sample
MyValue = Int((i * Rnd) + 1)
Account = Cells(MyValue, 1)
With Sheets("Samples")
.Cells(SampleRows, 1) = Account
End With
SampleRows = SampleRows + 1
j = j + 1
Loop
End Sub

[John Walkenbach]

One approach is to copy all of your records to a new location, then add a
new column that contains this formula:

=RAND()

Sort the records using the random column, and then select the first n% (or
delete all but the first n%). That will ensure that no record is selected
more than once.

John Walkenbach
For Excel tips, macros, & downloads...
http://j-walk.com/ss

"Mike" <stin...@hotmail.com> wrote in message
news:926001c208a8$5fd68f20$36ef2ecf@tkmsftngxa12...

[Ken Macksey]

Hi

This is one of many ways you can do what you wish. Change the number ranges
to suit.

Private Sub CommandButton1_Click()

' store numbers 1 to 100 in an array
For i = 1 To 100
anumber(i) = i
Next i

' Loop thru the rows and columns and put a different number in each cell
For Row = 1 To 10
For col = 1 To 10
newnumber:
Randomize
Number = Int(100 * Rnd) + 1
' pick a number and check that it has not already been used
If anumber(Number) = "" Then
' if it has been used, go back and pick another number
GoTo newnumber
Else
' when a number is picked, delete it from the array
Cells(Row, col) = Number
anumber(Number) = ""
End If

Next col
Next Row

End Sub

HTH

Ken M

[dave]

One option

before you paste the accoutn number to samples, run a loop
to match the account number against your list, if no
match, then paste, if match, continue with your sampling.

Dave

>..Range("A3:A5000").Clear

>End With
>For Each cell In Range("A5:A" & Range("A" &
Rows.Count).End
>(xlUp).Row)
>i = i + 1
>Next
>Sample = i * (Per / 100)
>
>Do While j <> Sample
>MyValue = Int((i * Rnd) + 1)
>Account = Cells(MyValue, 1)
>With Sheets("Samples")

>..Cells(SampleRows, 1) = Account

>End With
>SampleRows = SampleRows + 1
>j = j + 1
>Loop
>End Sub

>.
>

[Owen]

Hi Mike

I actually just set up a similar sort of program and used
a do loop with a worksheet.application.countif statement
to verify uniqueness, Im sure there is probably a way to
do this keeping it all in VBA but this worked for me. I
havent tested the code below but this should give you an
idea of what I did..

HTH
Owen

......

Do While j <> Sample
Dim bUnique As Boolean
Do

MyValue = Int((i * Rnd) + 1)
Account = Cells(MyValue, 1)

If Application.WorksheetFunction.CountIf(Sheets
("Samples").Range("a3:A5000"), Account) = 0 Then
bUnique = False
Else
bUnique = True
End If
Loop Until bUnique = True
With Sheets("Samples")

......

>..Range("A3:A5000").Clear

>End With
>For Each cell In Range("A5:A" & Range("A" &
Rows.Count).End
>(xlUp).Row)
>i = i + 1
>Next
>Sample = i * (Per / 100)
>
>Do While j <> Sample
>MyValue = Int((i * Rnd) + 1)
>Account = Cells(MyValue, 1)
>With Sheets("Samples")

>..Cells(SampleRows, 1) = Account

>End With
>SampleRows = SampleRows + 1
>j = j + 1
>Loop
>End Sub

>.
>

[Tushar Mehta]

I really should create a web page for the different random selection
options that don't seem to be popular but which I prefer ;-)

A single-pass algorithm that selects n elements out of m elements in an
array (and returns the information in the same array!) is the untested:

sub Swap(byref Arr() as variant, byval i as long, byval j as long)
dim temp as variant
temp=arr(i):arr(i)=arr(j):arr(j)=temp
end sub
sub RandomSelect(byref Arr() as variant, byval n as long)
'm is implicit in the size of Arr
'when the procedure is complete, the high-order n elements _
of the array will contain the unique random elements
dim i as long, thisIdx as long
'need edits to ensure Arr is an acceptable data type
'similarly, validate n
for i=1 to n
thisIdx=lbound(arr) _
+int(( ubound(arr)-(i-1) -lbound(arr) +1)*rand())
Swap arr,ubound(arr)-(i-1),thisidx
next i
end sub

--
Regards,

Tushar Mehta
www.tushar-mehta.com
Microsoft MVP -- Excel
--

In <926001c208a8$5fd68f20$36ef2ecf@tkmsftngxa12>, Mike
<stin...@hotmail.com> wrote