How to spin with rnd() no repetion (1 Viewer)

btamsgn

Member
Local time
Today, 20:54
Joined
Nov 8, 2010
Messages
50
Hi Everyone,
I have a form with button spin and 3 textboxes.
I want to spin after each click on button then txtdayso contains random numbers no repetion
Pls find the attachment for your ref.
Pls guide and show your code to fix the issue.
 

Attachments

  • dbspin.accdb
    448 KB · Views: 25

MajP

You've got your good things, and you've got mine.
Local time
Today, 09:54
Joined
May 21, 2018
Messages
8,529
If you like to give them an option to start a new round then

Code:
Option Compare Database
Option Explicit


Private UsedValues As New Dictionary
'I added a reference to Microsoft Scripting Runtime


Private Sub cmdspin_Click()
 Dim rnd As Integer


 If UsedValues.Count >= 15 Then
   If MsgBox("All numbers selected. Would you like to start over?", vbYesNo, "Complete") = vbYes Then
     Set UsedValues = New Dictionary
     txths = 1
     rnd = GetRandomInRange(1, 15)
     txtrnd = rnd
     txtdayso = "#" & rnd
   End If
 Else
   txths = txths + 1
   rnd = GetRandomInRange(1, 15)
   txtrnd = rnd
   txtdayso = txtdayso & "#" & rnd
 End If
End Sub


Public Function GetRandomInRange(minrange As Integer, MaxRange As Integer) As Integer
  Randomize
  Dim TempRnd As Integer
  Dim newVal As Boolean
   If minrange < MaxRange Then
    Do
      TempRnd = Int((MaxRange - minrange + 1) * rnd) + minrange
      If Not UsedValues.Exists(TempRnd) Then
         UsedValues.Add TempRnd, TempRnd
         newVal = True
         GetRandomInRange = TempRnd
      End If
    Loop Until newVal
  End If
 
End Function
 
Last edited:

btamsgn

Member
Local time
Today, 20:54
Joined
Nov 8, 2010
Messages
50
Hi Majp,
If I add Private UsedValues As New dictionary after option explicit then error:
1708534321230.png
 

btamsgn

Member
Local time
Today, 20:54
Joined
Nov 8, 2010
Messages
50
and if I delete Private UsedValues As New dictionary after option explicit then error:
error:
1708534409341.png
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 09:54
Joined
May 21, 2018
Messages
8,529
At the top of my original code
Code:
Private UsedValues As New dictionary
'I added a reference to Microsoft Scripting Runtime

I made the comment that I added the reference.
The dictionary is in Microsoft Scripting Runtime
Or you could late bind it and create it in the forms on load event or use something like a collection instead.
 
Last edited:

MajP

You've got your good things, and you've got mine.
Local time
Today, 09:54
Joined
May 21, 2018
Messages
8,529
Here is a version with a collection instead of dictionary. A little simpler to use since needs to reference, but exact same idea.

Code:
Option Compare Database
Option Explicit

Private UsedValues As New Collection
'No reference required

Private Sub cmdspin_Click()
Dim rnd As Integer

'rnd = laySoNgauNhien(1, 15)
If UsedValues.Count >= 15 Then
   If MsgBox("All numbers selected. Would you like to start over?", vbYesNo, "Complete") = vbYes Then
     Set UsedValues = New Collection
     txths = 1
     rnd = GetRandomInRange(1, 15)
     txtrnd = rnd
     txtdayso = "#" & rnd
   End If
Else
   txths = txths + 1
   rnd = GetRandomInRange(1, 15)
   txtrnd = rnd
   txtdayso = txtdayso & "#" & rnd
End If
End Sub

Public Function GetRandomInRange(minrange As Integer, MaxRange As Integer) As Integer
  Randomize
  Dim TempRnd As Integer
  Dim newVal As Boolean
   If minrange < MaxRange Then
    Do
      TempRnd = Int((MaxRange - minrange + 1) * rnd) + minrange
      If Not Exists(TempRnd) Then
         UsedValues.Add TempRnd, CStr(TempRnd)
         newVal = True
         GetRandomInRange = TempRnd
      End If
    Loop Until newVal
  End If

End Function

Public Function Exists(TheVal As Variant) As Boolean
  Dim i As Integer
  For i = 1 To UsedValues.Count
    If UsedValues.Item(i) = TheVal Then
      Exists = True
      Exit Function
    End If
  Next i
End Function
 

Attachments

  • dbspin_MajP.accdb
    628 KB · Views: 27
Last edited:

Josef P.

Well-known member
Local time
Today, 15:54
Joined
Feb 2, 2023
Messages
826
Another variant: Create an array with the numbers 1-15, shuffle the array and then output from index 1-15.
In other words: simulate a lottery wheel

Basic concept:
Code:
Private Sub TestShuffleArray()

   Dim IntegerArray(1 To 15) As Long
   Dim i As Long

' Fill array
   For i = LBound(IntegerArray) To UBound(IntegerArray)
      IntegerArray(i) = i
   Next

' mix it ..
   ShuffleArray IntegerArray

' output
   For i = LBound(IntegerArray) To UBound(IntegerArray)
      Debug.Print IntegerArray(i),
   Next
   Debug.Print

End Sub

Private Sub ShuffleArray(ByRef ArrayToShuffle As Variant, Optional ByVal MaxSteps As Long = 0)

    Dim MaxArrayIndex As Long, MinArrayIndex As Long
    Dim MaxIndexToShuffle As Long
    Dim i As Long
    Dim IndexToReplace As Long
 
    MinArrayIndex = LBound(ArrayToShuffle)
    MaxArrayIndex = UBound(ArrayToShuffle)
 
    If MaxSteps = 0 Then 'shuffle all
        MaxIndexToShuffle = MaxArrayIndex
    Else ' shuffle only first n (=MaxSteps) items
        MaxIndexToShuffle = MaxSteps - 1 + MinArrayIndex
    End If
 
    Randomize Now()
 
    For i = MinArrayIndex To MaxIndexToShuffle
         IndexToReplace = Int(((MaxArrayIndex - i + 1) * rnd()) + i)
         SwapValues ArrayToShuffle(i), ArrayToShuffle(IndexToReplace)
    Next i
     
End Sub

Private Sub SwapValues(ByRef Value1 As Variant, ByRef Value2 As Variant)

   Dim TempVal As Variant

   TempVal = Value1
   Value1 = Value2
   Value2 = TempVal

End Sub

Or play Lotto ...
Code:
Private Sub TestPlayLotto()

   PlayLotto 59, 6

End Sub

Private Sub PlayLotto(Optional ByVal MaxPoolNumber As Long = 59, Optional ByVal SelectNumbers As Long = 6)

   Dim IntegerArray() As Long
   Dim i As Long

   ReDim IntegerArray(1 To MaxPoolNumber)

   For i = 1 To MaxPoolNumber
      IntegerArray(i) = i
   Next

   ShuffleArray IntegerArray, SelectNumbers

   Debug.Print "Lotto numbers: ";
   For i = 1 To SelectNumbers
      Debug.Print IntegerArray(i),
   Next
   Debug.Print

End Sub

Private Sub ShuffleArray(ByRef ArrayToShuffle As Variant, Optional ByVal MaxSteps As Long = 0)

    Dim MaxArrayIndex As Long, MinArrayIndex As Long
    Dim MaxIndexToShuffle As Long
    Dim i As Long
    Dim IndexToReplace As Long
 
    MinArrayIndex = LBound(ArrayToShuffle)
    MaxArrayIndex = UBound(ArrayToShuffle)
 
    If MaxSteps = 0 Then 'shuffle all
        MaxIndexToShuffle = MaxArrayIndex
    Else ' shuffle only first n (=MaxSteps) items
        MaxIndexToShuffle = MaxSteps - 1 + MinArrayIndex
    End If
 
    Randomize Now()
 
    For i = MinArrayIndex To MaxIndexToShuffle
         IndexToReplace = Int(((MaxArrayIndex - i + 1) * rnd()) + i)
         SwapValues ArrayToShuffle(i), ArrayToShuffle(IndexToReplace)
    Next i
     
End Sub

Private Sub SwapValues(ByRef Value1 As Variant, ByRef Value2 As Variant)

   Dim TempVal As Variant

   TempVal = Value1
   Value1 = Value2
   Value2 = TempVal

End Sub
 
Last edited:

Users who are viewing this thread

Top Bottom