X Unique Randomize Numbers - excel

Question

i need a little bit help.
Is it possible to fill a list with random numbers and to check this list before each loop to see if the number already exists?
I think im on the wrong way with my VBA.
Sub Zufallszahlen()
Dim Rng As Range
Max = 6
Min = 1
Anzahl = 4
counter = 0
innercounter = 0
SZeile = 2
AWert = "X"
Range("C:C").Clear
Do
counter = counter + 1
ZZahl = Int((Max * Rnd) + Min)
innercounter = 0
Do
innercounter = innercounter + 1
If Cells(innercounter, 2) = ZZahl Then
ZZahl = Int((Max * Rnd) + Min)
Else
Loop Until innercounter = Anzahl
' Cells(counter, 1).Value = counter
Cells(counter, 2).Value = ZZahl
Cells(ZZahl, 3).Value = AWert
Loop Until counter = Anzahl
Range("B:B").Clear
End Sub

Answer 1

Use an array to check if random number has already been chosen. Repeat until a vacant array position is found.
Option Explicit
Sub Zufallszahlen()
Const MaxN = 6
Const MinN = 1
Const Anzahl = 4
Const Awert = "X"
Dim ar, n As Long, r As Long, i As Long
n = MaxN - MinN + 1
If n < Anzahl Then
MsgBox "Min to Max range must be >= " & Anzahl
Exit Sub
End If
' values in column B
Dim arB, total As Single, try As Long
arB = Range("B" & MinN).Resize(n).Value2
Do
' avoid endless loop
try = try + 1
If try > 100 Then
MsgBox "Could not solve in 100 tries", vbExclamation
Exit Sub
End If
' generate random selection
ReDim ar(1 To n, 1 To 1)
total = 0
For i = 1 To Anzahl
Do
r = 1 + Int(n * Rnd())
Loop Until ar(r, 1) = ""
ar(r, 1) = Awert
' sum col B
total = total + arB(r, 1)
Next
Range("C:C").Clear
Range("C" & MinN).Resize(n) = ar
Loop Until total >= 10 And total <= 20 ' check total in range
MsgBox "Total=" & Format(total, "0.00"), vbInformation, try & " tries"
End Sub

Answer 2

You can use the Scripting.Dictionary object to check.
Given it's a "Dictionary", it requires that all keys are unique.
This is a crude implementation demonstrating the random filling of that dictionary with all numbers between 50 and 100.
Public Sub DoRandomize()
Dim objUnique As Object, i As Long, lngRandom As Long
Dim lngMin As Long, lngMax As Long, dblRandom As Double
lngMin = 50: lngMax = 100
Set objUnique = CreateObject("Scripting.Dictionary")
Do While objUnique.Count <> (lngMax - lngMin) + 1
Randomize objUnique.Count
lngRandom = (Rnd(objUnique.Count) * (lngMax - lngMin)) + lngMin
If Not objUnique.exists(lngRandom) Then
Debug.Print "Adding ......... " & lngRandom
objUnique.Add lngRandom, vbNull
Else
Debug.Print "Already used ... " & lngRandom
End If
Loop
End Sub
... you'd just need to pull out the relevant parts for your implementation but you can paste that code into your project, run it and see it work for yourself.

Answer 3

Ty Guys thats perfect =) i use this now and it works very nice + i understand my
misconception
Sub Zufallszahlen()
Const MaxN = 29
Const MinN = 1
Const Anzahl = 4
Const Awert = "X"
Dim ar, n As Long, r As Long
n = MaxN - MinN + 1
If n < Anzahl Then
MsgBox "Min to Max range must be >= " & Anzahl
Exit Sub
End If
ReDim ar(1 To n, 1 To 1)
For i = 1 To Anzahl
Do
r = 1 + Int(n * Rnd())
Loop Until ar(r, 1) = ""
ar(r, 1) = Awert
Next
Range("C:C").Clear
Range("C" & MinN).Resize(n) = ar
End Sub
Buts not finally completed.
Can I include this part in another if?
This is intended to ensure that the values ​​of the cells to the left of the cells randomly marked with an x ​​add up to between 10 and 20, for example. Otherwise the random cells should be regenerated