VBA- Random Number Generator

Prayder

Registered User.
Local time
Today, 16:37
Joined
Mar 20, 2013
Messages
303
I am trying to create a random number generator that would populate a number between 8-48 to 9 different lanes with the only criteria being that each lane number cannot be within 5 of any lane within 3 spaces of it. So what I mean is if lane 4 has a number of 30 then lane 1-2-3 and lane 5-6-7 cannot be within 5 of lane 4's number. Hope this makes sense and any help would be sincerely appreciated....
 
As more of a general working template, I offer this LOC:

Code:
  'CInt() formula comes up with a random number between 1000 and 9999
  CInt((9999 - 1000 + 1) * Rnd() + 1000)
 
I am trying to create a random number generator that would populate a number between 8-48 to 9 different lanes with the only criteria being that each lane number cannot be within 5 of any lane within 3 spaces of it. So what I mean is if lane 4 has a number of 30 then lane 1-2-3 and lane 5-6-7 cannot be within 5 of lane 4's number. Hope this makes sense and any help would be sincerely appreciated....

I don't generally do other peoples code for them, but this sounded like fun. Here's what I came up with, think it does what you want, but since it's not a pay gig I don't really feel too bad if it doesn't ;)

Code:
Option Compare Database
Option Explicit

Public Type LaneAssignments
    laneNumber As Integer
    laneValue As Integer
End Type

Public Type LaneMap
    laneNumber As Integer
    lanesToCheck As Variant
End Type

Dim lnAR As Variant
Dim lColl(1 To 9) As LaneAssignments
Dim lMap(1 To 9) As LaneMap

Function BuildLaneMap()
Dim x As Integer


For x = 1 To 9

    Select Case x
        Case 1
            lMap(x).laneNumber = x
            lMap(x).lanesToCheck = Array(2, 3, 4)
        Case 2
            lMap(x).laneNumber = x
            lMap(x).lanesToCheck = Array(1, 3, 4, 5)
        Case 3
            lMap(x).laneNumber = x
            lMap(x).lanesToCheck = Array(1, 2, 4, 5, 6)
        Case 4
            lMap(x).laneNumber = x
            lMap(x).lanesToCheck = Array(1, 2, 3, 5, 6, 7)
        Case 5
            lMap(x).laneNumber = x
            lMap(x).lanesToCheck = Array(2, 3, 4, 6, 7, 8)
        Case 6
            lMap(x).laneNumber = x
            lMap(x).lanesToCheck = Array(3, 4, 5, 7, 8, 9)
        Case 7
            lMap(x).laneNumber = x
            lMap(x).lanesToCheck = Array(4, 5, 6, 8, 9)
        Case 8
            lMap(x).laneNumber = x
            lMap(x).lanesToCheck = Array(5, 6, 7, 9)
        Case 9
            lMap(x).laneNumber = x
            lMap(x).lanesToCheck = Array(6, 7, 8)
    End Select

Next x


End Function

Function AssignLanes()
Dim x As Long

BuildLaneMap
BuildLanes

For x = 1 To 9
    
    Dim i As Integer
    
rTry:
    i = MakeLaneValue
    
    Dim ln As LaneAssignments
    
    ln.laneNumber = x
    ln.laneValue = i
    
    If CheckIfValid(ln) Then
        lColl(x) = ln
    Else
        GoTo rTry
    End If
    
Next x

For x = 1 To 9
    Debug.Print "Lane " & lColl(x).laneNumber & " = " & lColl(x).laneValue
Next x

End Function

Function BuildLanes()
Dim x As Integer

For x = 1 To 9
    lColl(x).laneNumber = x
Next x

End Function

Function CheckIfValid(ln As LaneAssignments) As Boolean

Dim l As LaneMap, isGood As Boolean
isGood = True

l = lMap(ln.laneNumber)

Dim i As Variant

For Each i In lMap(ln.laneNumber).lanesToCheck
    If (lColl(i).laneValue > 0) Then
        isGood = isGood And (Abs(ln.laneValue - lColl(i).laneValue) > 5)
    End If
Next i

CheckIfValid = isGood


End Function

Function MakeLaneValue() As Integer

MakeLaneValue = Int((48 - 8 + 1) * Rnd + 8)

End Function
 
  • Like
Reactions: Rx_
For immediate window run this for a random number between 0 and 48, then if it returns a number less than 8 run it again (maybe a do while loop or some structure).
? Rnd * 2 ^ 24 mod 48
Rnd has a period of 2^24 (16,777,216). No matter where it starts, it will cycle through the entire list and repeat itself. Using the max set is my suggestion. Note: Don't use this for wagering!

A great overview of random numbers - why Excel random doesn't work as well as VBA - anyone reading this later looking at serious random generation might want to visit:
http://www3.wabash.edu/econometrics/EconometricsBook/Basic Tools/ExcelAddIns/MCSimNV.htm

For anyone using random numbers in Access (or vba in Excel) check out this attachment. Be sure to review some of the VBA code. It generates some nice graphics.


In the case of the question, use an Array and somthing along the line of the looping methology for generating pairs in the Excel attachment.
Of interest: These formuas for the Excel attachment generated charts. If anything, the charts alone should indicate that the Excel RAND function should not ever be used.
 

Attachments

So How can I put this into a module in access and test it?
 
http://www.alvechurchdata.co.uk/accrandom.htm
Could not find this yesterday - this is one of the better articles about random number generators for MSAccess. I use this to randomally generate dates and Yes / No for testing sometimes.
It is good to remember that it is not truly random. See the sequence aspect.
 
In Code modules create new. Paste the code in the new module and save.
Put a break point (F9) anywhere after the last Dim statement
in the Immediate Window enter ? BuildLaneMap()
Then step through the code.
The numbers are stored in the public data types as part of a variable array.
Great idea and design provided to you.

To learn about array variables and how to use them wiht vba - look at this.
http://msdn.microsoft.com/en-us/library/office/aa140074(v=office.10).aspx
 
Here's a db that solves the lane problem.
 

Attachments

If I wanted to extend each one of those numbers and turn them into rows of numbers with the same criteria.....how could I do that?
 
You talking to me? I don't understand. Extend them? Turn them into rows? Do you mean print them horizontally, not vertically, or save them in a table or spreadsheet?
 
You talking to me? I don't understand. Extend them? Turn them into rows? Do you mean print them horizontally, not vertically, or save them in a table or spreadsheet?

Yes Sorry for the confusion.. I meant save them in a table once they were created.
 
To save data to a table you use a recordset or a querydef, but that should probably be a different thread. But before that, do a search for how to save data to a table using a recordset, and I'm sure you'll find tons of info.
Cheers,
 

Users who are viewing this thread

Back
Top Bottom