Randomize individual numbers

barissh · Nov 19, 2009

I have a macro which is creating randomize different numbers. But this code generates only 22 numbers and then freezing. I don't understand why.

Can someone help me how to create (not equal) 30 numbers or more ?

Code:

Sub test()
Dim num As Long, x As Range, a As Long
Randomize
For a = 1 To 29
    Do
        num = Int((30 * Rnd) + 1)
        Set x = Range("A1:A30").Find(num)
    Loop Until x Is Nothing
    Range("A" & a) = num
Next a
End Sub

GTO · Nov 19, 2009

Greetings,

You can try this if you'd like. In a new/blank wb...

In a Standard Module:OptionExplicit Function MULTIRAND(Optional LowNumberAsLong = 1, _ Optional HighNumberAsLong, _ Optional HowManyValsAsLong, _ Optional NonVolAsBoolean, _ Optional Dim1_UboundAsLong, _ Optional Dim2_UBoundAs Long _ )AsVariant Dim _ Target As Range, _ i AsLong, _ x AsLong, _ y AsLong, _ aryVals AsVariant, _ aryTemp AsVariant Const ULIMIT AsLong = 15000 If TypeName(Application.Caller) = "Range"Then IfNot NonVolThen Application.Volatile Set Target = Application.Caller If Target.Cells.Count > 1Then If HowManyVals = 0Then HowManyVals = Target.Cells.Count If HighNumber = 0Then HighNumber = HowManyVals * 100 HighNumber = Application.Min(HighNumber, ULIMIT) If Target.Areas.Count > 1 _ Or (Target.Cells.Count< HowManyVals And Target.Cells.Count > 1)Then MULTIRAND = "BOTCHED" ExitFunction EndIf ReDim aryVals(1To Target.Rows.Count, 1To Target.Columns.Count) aryTemp = RANDVALS_RET(LowNumber, HighNumber, HowManyVals) ReDimPreserve aryTemp(LBound(aryTemp) To _ UBound(aryTemp) + _ (Target.Cells.Count - _ (UBound(aryTemp) -LBound(aryTemp) + 1))) i =LBound(aryTemp) For x =LBound(aryVals, 1)ToUBound(aryVals, 1) For y =LBound(aryVals, 2)ToUBound(aryVals, 2) IfNot aryTemp(i) =EmptyThen aryVals(x, y) = aryTemp(i) i = i + 1 Else aryVals(x, y) = vbNullString EndIf Next Next MULTIRAND = aryVals Else If HowManyVals = 0Then HowManyVals = 1 If HighNumber = 0Then HighNumber = HowManyVals * 100 HighNumber = Application.Min(HighNumber, ULIMIT) MULTIRAND = Join(RANDVALS_RET(LowNumber, HighNumber, HowManyVals), ", ") EndIf Else If Dim1_Ubound > 0 And Dim2_UBound > 0Then ReDim aryVals(1To Dim1_Ubound, 1To Dim2_UBound) HowManyVals = Dim1_Ubound * Dim2_UBound If HighNumber = 0Then HighNumber = HowManyVals * 100 HighNumber = Application.Min(HighNumber, ULIMIT) aryTemp = RANDVALS_RET(LowNumber, HighNumber, HowManyVals) i =LBound(aryTemp) For x =LBound(aryVals, 1)ToUBound(aryVals, 1) For y =LBound(aryVals, 2)ToUBound(aryVals, 2) aryVals(x, y) = aryTemp(i) i = i + 1 Next Next MULTIRAND = aryVals ElseIf Dim1_Ubound > 0Then ReDim aryVals(1To Dim1_Ubound) HowManyVals = Dim1_Ubound If HighNumber = 0Then HighNumber = HowManyVals * 100 HighNumber = Application.Min(HighNumber, ULIMIT) MULTIRAND = RANDVALS_RET(LowNumber, HighNumber, HowManyVals) Else If HowManyVals > HighNumber - LowNumber + 1Then MULTIRAND = vbNullString ExitFunction EndIf If HowManyVals = 0Then HowManyVals = 1 If HighNumber = 0Then HighNumber = HowManyVals * 100 HighNumber = Application.Min(HighNumber, ULIMIT) MULTIRAND = Join(RANDVALS_RET(LowNumber, HighNumber, HowManyVals), ", ") EndIf EndIf EndFunction PrivateFunction RANDVALS_RET(ByVal LowNumberAsLong, _ ByVal HighNumberAsLong, _ ByVal HowManyValsAs Long _ )AsVariant Dim _ i AsLong, _ lVal AsLong, _ lTemp AsLong, _ ary AsVariant, _ aryVals AsVariant ReDim ary(LowNumberTo HighNumber) For i =LBound(ary)ToUBound(ary) ary(i) = i Next Randomize For i = HighNumberTo LowNumber + 1Step -1 lVal = Int(Rnd() * (i - LowNumber + 1)) + LowNumber lTemp = ary(lVal) ary(lVal) = ary(i) ary(i) = lTemp Next ReDim aryVals(1To HowManyVals) lVal = 0 For i = LowNumberTo LowNumber + HowManyVals - 1 lVal = lVal + 1 aryVals(lVal) = ary(i) Next RANDVALS_RET = aryVals EndFunction

To use as a UDF:

Excel Workbook

A

1

182

2

140

3

70

4

112

5

88

6

40

7

48

8

184

9

11

10

169

Sheet2

Excel 2003

#VALUE!

Entered with Ctrl+Shift+Enter. If entered correctly, Excel will surround with curly braces {}.

Please note you can adjust lowermost value, highest, number of rand vals to return. I just used ten cells to keep the post sized...

Hope that helps,

Mark

pgc01 · Nov 19, 2009

Hi barissh

In your code set the Find to look for entire cell values:

Code:

        Set x = Range("A1:A30").Find(num[COLOR=red], LookAt:=xlWhole[/COLOR])

Legacy 14611 · Nov 19, 2009

Try

Code:

Sub randomz()
Dim n, a, i, x,y
n = 29
ReDim a(1 To n, 1 To 1)
For i = 1 To n: a(i, 1) = i: Next i
For i = 1 To n
    x = Fix(Rnd * (n)) + 1
    y = a(i, 1)
    a(i, 1) = a(x, 1)
    a(x, 1) = y
Next i
Range("A1").Resize(n, 1) = a
End Sub

barissh · Nov 19, 2009

Dear All,

Many thanks for your kind assist.

GTO = many thanks fr yr looonngg codes. To be honest, I am confused with it
pgc01 = sorry but it doesn't work.
rugila = Many many thanks fr yr help. Yr macro works as I want. That's it

Meanwhile I found what is problem with my previous code.

num value should be higher than for next value. But this time it generates 1 number missing. I mean, my purpose is to generate 30 random not equal numbers between 1 -30. If num value gets higher than for next value then when makro generates 31, there will be 1 number missing between 1-30.

Anyway, rugila 's makro is working perfectly. My problem has been fixed.

Many thanks fr everyone again.

Legacy 14611 · Nov 19, 2009

Thanks for feedback.

Maybe minor point, but I'd be a bit happier if you used this version instead. You may not note any difference, but ...

Code:

Sub randomz2()
Dim n, a, i, x, y
n = 29
ReDim a(1 To n, 1 To 1)
For i = 1 To n: a(i, 1) = i: Next i
For i = 1 To n
    x = i + Fix(Rnd * (n - i + 1))
    y = a(i, 1)
    a(i, 1) = a(x, 1)
    a(x, 1) = y
Next i
Range("A1").Resize(n, 1) = a
End Sub

barissh · Nov 19, 2009

Dear rugila,

I don't know what is the difference but as per your advise I will use randomz2.

Thanks again.

Randomize individual numbers

barissh

Board Regular

Excel Facts

GTO

MrExcel MVP

pgc01

MrExcel MVP

Legacy 14611

Guest

barissh

Board Regular

Legacy 14611

Guest

barissh

Board Regular

Similar threads

Forum statistics

Share this page

Randomize individual numbers

barissh

Board Regular

Excel Facts

GTO

MrExcel MVP

pgc01

MrExcel MVP

Legacy 14611

Guest

barissh

Board Regular

Legacy 14611

Guest

barissh

Board Regular

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock