We help IT Professionals succeed at work.

# conditions in randomize

on
Hi

the following code is typed by an expert as an answer in my quetion titled "Randomize"  it is a right answer :

Private Sub Command1_Click()
Dim i As Integer
Dim j As Integer
Dim MyValue As Integer
Dim array_temp(6) As Integer
Dim Response As VbMsgBoxResult

i = 1
While i <= 6
Randomize    ' Initialize random-number generator.

MyValue = Int((6 * Rnd) + 1)    ' Generate random value between 1 and 6.
For j = 1 To 6
If array_temp(j) <> 0 Then
If MyValue = array_temp(j) Then
Exit For
End If
Else
array_temp(j) = MyValue
MsgBox MyValue
Response = MsgBox("Roll again? ", vbYesNo)
i = i + 1
Exit For
End If
Next

If Response = vbNo Then
i = 100
End If
Wend
End Sub

this code succeed to let the computer choose a number between 1 and 6 once not more than one time.
for example (3,6,5,4,2,1) not (2,2,5,6,3,5)

now i ask how can i change this code to put some conditions in distributing these numbers , for example:
4 comes in the first part , 5 in the second part , 1 in the end . then what is the way to put conditions.

thanks
asns
Comment
Watch Question

## View Solution Only

Commented:
Not sure what you mean, do you want to change the chances of a particular number to come up more than others?

Commented:
asns,

That really confused me.  You want them random, but, you want them in a certain order?

Can you explain a little better what your wanting the outcome to be?

dill

Commented:
Or do you want something like

if Myvalue = 1 then
'do something
else
end
end if

Commented:
Ahhhh, I think you probably have it SirNick.  Boy, was I confused.

dill

Commented:
I once made a fruit machine game which used a random number, but I needed to make number 6 come up less frequent than 1 2 3 4 5.

Is this what you want.

Commented:
Hi sirs

yes i want to random but at the same time be able to control this randomize ...
Otherwise i am thinking about filling the places in the array which i need conditions then the free places to be randomized. for example: changing the code to fill the second place in the array by 5, the fifth by 3 , the last by 1 , after that randomize in free places by the other numbers (2,4,6)

i hope it is clear now!!

By the way can you show me how can i save the array ?

thanks
asns

Commented:
Hi asns

Do you mean you are going to fill an array up with numbers and then use the randomize method to choose a number in the array so you can retrieve the stored number?
Commented:
Option Explicit

Private Sub Command1_Click()
Dim vPos As Variant, vVal
Dim intIndex As Integer
Dim intArray(1 To 6) As Integer
Dim intVal As Integer

Randomize
'The order of this array is such that we will place the numbers with conditions first.
vVal = Array(4, 5, 1, 2, 3, 6)

For intIndex = 0 To 5

intVal = vVal(intIndex) 'take value from array
Select Case intVal  'Set any possible position conditions
Case 4
vPos = Array(1, 2, 3) 'Possible positions for 4
Case 5
vPos = Array(4, 5) 'Possible positions for 5
Case 1
vPos = Array(6) 'Possible positions for 1
Case Else
vPos = Array(1, 2, 3, 4, 5) 'Possible positions for other numbers
End Select

Call sInsert(intVal, vPos, intArray)  'insert at rand pos based on conditions

Next intIndex

Debug.Print
For intIndex = 1 To 6
Debug.Print intArray(intIndex),
Next
End Sub

Public Function fRndInt(intMin As Integer, intMax As Integer) As Integer
fRndInt = Int((intMax - intMin + 1) * Rnd + intMin)
End Function

Public Sub sInsert(intVal As Integer, vPos As Variant, intArray() As Integer)
Dim i As Integer
i = fRndInt(0, UBound(vPos))
Do Until intArray(vPos(i)) = 0  'Find an empty position
i = fRndInt(0, UBound(vPos))
Loop
intArray(vPos(i)) = intVal  'Insert at that position
End Sub

Commented:
Sounds like the array will look like:

(?,5,?,3,?,1)

The ?s are the only real random ones.  So, the only really random numbers are 2, 4, and 6.

dill

Commented:
Note that I wrote this code for your original conditions, you can easily change it to suit any other set of conditions.

Commented:
Oops...

(?,5,?,?,3,1)

dill
CERTIFIED EXPERT

Commented:
Hi

Seems in your case better first randomize not values, but positions and compare it with predefined:

'========Bas module code======
Public Enum POSSIBLE_PLACES
Place_Any_Where = &H0
Place_1 = &H1
Place_2 = &H2
Place_3 = &H4
Place_4 = &H8
Place_5 = &H10
Place_6 = &H20
Place_7 = &H40
Place_8 = &H80
Place_9 = &H100
'Add more if you need, just keep 'byte' order increasing
End Enum

Type NUMBERS_DATA
lValue As Long
NumPlace As POSSIBLE_PLACES
End Type

Public Type ARRAY_DATA
arrLBound As Long
arrUBound As Long
NumData() As NUMBERS_DATA
End Type

Public Function MakeRandom(ArrData As ARRAY_DATA) As Variant
Const EmptyValue = &HFFFF
Dim RandomArray() As Integer
Dim MyValue As Integer
Dim lMatchingFlags As POSSIBLE_PLACES
Dim lPos As Integer
ReDim RandomArray(1 To ArrData.arrUBound - ArrData.arrLBound + 1)
'Fill array with "Empty" data
For i = 1 To UBound(RandomArray)
RandomArray(i) = EmptyValue
Next i
'First, fill array with values which should match places
For i = LBound(ArrData.NumData) To UBound(ArrData.NumData)
lMatchingFlags = ArrData.NumData(i).NumPlace
If lMatchingFlags <> Place_Any_Where Then 'This value should match place
Do
'Get  Random position
Randomize
lPos = Int((UBound(RandomArray)) * Rnd + 1)
If RandomArray(lPos) = EmptyValue Then 'This pos is free
If (lMatchingFlags And 2 ^ (lPos - 1)) Then 'This position match criteria
RandomArray(lPos) = ArrData.NumData(i).lValue
Exit Do
End If
End If
Loop
End If
Next i
'Now, fill other places
For i = 1 To UBound(RandomArray)
If RandomArray(i) = EmptyValue Then 'This pos is still free - fill it!
Do
'Get  Random value
Randomize
MyValue = Int((ArrData.arrUBound - ArrData.arrLBound + 1) * Rnd + ArrData.arrLBound)
If ValueExists(MyValue, RandomArray) = False Then
RandomArray(i) = MyValue
Exit Do
End If
Loop
End If
Next i
For i = 1 To UBound(RandomArray)
Debug.Print RandomArray(i);
Next i
End Function

Private Function ValueExists(ByVal iVal As Integer, arr() As Integer) As Boolean
For i = LBound(arr) To UBound(arr)
If arr(i) = iVal Then
ValueExists = True
Exit For
End If
Next i
End Function

'======Using (Form Code)========
Private Sub Command1_Click()
'===This block required========
'=====This block optional========
ad.NumData(1).NumPlace = Place_1 + Place_2 + Place_3
'NOTE: Values with only one predefined place (like 1 below) should be placed BEFORE values that have this place in a list (like 5 below). Otherwise it can cause infinitive loop. (Imagine, Place_6 will assign to value 5 randomly, so value 1 will NEVER find it place). Though, places can interfere each other:
'   ad.NumData(1).NumPlace = Place_1 + Place_3 + Place_4
'   ad.NumData(2).NumPlace = Place_3 + Place_4 + Place_5
ad.NumData(3).NumPlace = Place_4 + Place_5 + Place_6
End Sub

Cheers

Commented:
Interesting Ark, very similar to the way my code functions only using a system of flags instead of an array.  If the number of positions was large, it might be better to replace the enum with a function that returns the flags based on a paramarray parameter.  I discovered the infinite loop the hard way.  Then realized I had to insert the qualified positions first (why I use the vVal array instead of simple for ... to loop to loop through the 6 values.)
CERTIFIED EXPERT

Commented:
Hello, Paul
Sorry for delay - my mail server is down and I don't receive notufications. Yes, both codes based on position(instead of values) randomizing. I tried to make 'universal' solution with function and randomized array twice - first for position, second with values.

Cheers