Excel VBA - macro to recalculate random numbers until target reached

[gregaw]

Hi

I'm trying to perform the following procedure and hopefully someone ca
help:

In cells A1..F1 in Excel I have a function =randbetween(1,20)
In cells G1..L1 I have the numbers 2,4,6,8,10,12

In cells A2..F2 I also have the function randbetween(1,20) and in cell
G2 to L2 I have the numbers 3,6,9,12,15,18

Each time one presses F9, the random numbers in A1..F2 wil
recalculate.

What I would like to perform if possible is the following routine i
the order that follows:

(1) Recalculate the spreadsheet until the condition is met tha
a1=g1,b1=h1,c1=i1,d1=j1,e1=k1 and f1=l1.
(2) Once that condition is met record in cell m1 how many times th
recalculation had to be performed until that condition was met.
(3) Also, once that condition is met paste g1..l1 over a1..f1 so tha
no further random number generations will occur in a1..f1.
(4) Move the routine on to the next row (i.e. row 2) and perform th
same procedure as in A1..F1 above.

Many thanks,
Gre

 

[Tom Ogilvy]

Sounds like some kind of lottery excercise. Unless order is relevant, your
approach does not model anything pertinent to the lottery.

also, randbetween doesn't generate unique random numbers, so this also
wouldn't match a lottery.

 

[JE McGimpsey]

One way:

Public Sub WaitALongLongLongTime()
Dim vCompare As Variant
Dim rTest As Range
Dim i As Long
Dim j As Long
Dim nCounter As Long
Dim bEqual As Boolean
Dim nTrials(1 To 2) As Long

With Application
.ScreenUpdating = False
.Calculation = xlManual
End With
For i = 1 To 2
Set rTest = Cells(i, 1).Resize(1, 6)
vCompare = Cells(i, 7).Resize(1, 6).Value
nCounter = 0
Do
nCounter = nCounter + 1
If nCounter Mod 1000 = 0 Then _
Application.StatusBar = "Trial i: " & nCounter
bEqual = True
rTest.Calculate
j = 1
Do
bEqual = bEqual And (rTest(j).Value = vCompare(1, j))
j = j + 1
Loop While bEqual And j <= 6
Loop Until bEqual
nTrials(i) = nCounter
Next i
With Application
.StatusBar = False
.Calculation = xlAutomatic
.ScreenUpdating = True
End With
MsgBox "Trial 1: " & nTrials(1) & vbNewLine & _
"Trial 2:" & nTrials(2)
End Sub

Since the probability of hitting each exact permutation is 1/(20^6), or
one in 64 million, expect to be running this routine for a *long* time.
Even at a relatively brisk 1000 recalculations per second, your expected
wait for the two trials is over 35 hours. Of course it could either be
shorter, or much, much longer.

Of course, if this is a lottery exercise, the code above won't help you
at all, since lotteries usually don't require both the correct numbers
and the correct order of drawing. Nor do lotteries allow duplication,
which RANDBETWEEN() does.

Then again, since there's absolutely nothing XL can do to help you win
the lottery (except possibly to convince one of the abject futility of
trying to use any "system"), I'll assume there's some other reason you
want this...