Variable count and bound random numbers

G

goaljohnbill

I need to create a variable sized list of random numbers with a
variable sized range without duplicate values. I have been creating
the list with a variable range with the following code then manually
changing any dup values (checking changes by sorting the list and
filtering uniques). I would like to replace this with something that
uses the count, default and input box to create the list without dups
on the first try. I tried looking through the site for a solution but
the stuff that looked like it might be what I wanted I couldn't figure
out how to add my variables to at all. Thank you in advance for any
assistance.

Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Dim reccount As Double
Dim recdefault As Double
Dim trunrecdef As Integer
Dim recpct As Double

reccount = Selection.Count
'counts records to determine upperbound
recdefault = 117
'default number of random numbers required
trunrecdef = Fix(recdefault)
'this step gives whole # if math on default
Do
recpct = Application.InputBox(Prompt:=("How many PRV lots to
keep" & vbLf & "Max lots allowed " &_ reccount),Title:="Number PRV
lots to test", Default:=trunrecdef, Type:=1)
Loop Until recpct <= reccount
'input number of random numbers, wont take #
higher than reccount
ActiveWindow.Close
'closes file count was performed on
Workbooks.Open Filename:= _
"T:\Groups\PAM\Meat Juice Lab\Processing lab B7\Current
selective\s_5 to 2 PSS\N_RandID.xls"
'file rand # list goes on
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Range("A2").Select
ActiveCell.FormulaR1C1 = "=RANDBETWEEN(1," & reccount & ")"
' sets randbetween to 1-count of records
Selection.Copy
ActiveCell.Offset(1, 0).Select
StartCell = ActiveCell.Offset(0, 0).Address
EndCell = ActiveCell.Offset(recpct - 2, 0).Address
Range(StartCell, EndCell).Select
'selects range to copy randbetween to
ActiveSheet.Paste
 
J

Joel

I used the VBA random function a put values into the cells rather than a
formula. The find function makes sure there are no duplicates.

For Count = 1 To Recpct
Set SearchRange = Range("A2:A" & (Count + 1))
Do
RandNum = ((reccount - 1) * Rnd()) + 1
Set c = SearchRange.Find(what:=RandNum, LookIn:=xlValues)
Loop While Not c Is Nothing
Range("A" & (Count + 1)) = RandNum
Next Count
 
G

goaljohnbill

Thanks for the help guys. What would i do to get joels code snippet to
give whole numbers instead of decimals?
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top