Solved: Arbitrary Array

[johnske]

Hi all,

I'm writing a procedure to run a game, ideally, as well as "standard" games, there should be a choice for each game to be different. To do this, I would need a VBA procedure to initialize each game such that after running it:

The cells G2 to J7 will contain every consecutive number from 0 to 23, but with these provisions:

1) J7 will always be zero

2) The remaining cells would contain the numbers 1 to 23, but in RANDOM order

Any ideas?
Regards,
John

[alimcpill]

this will do it, but it's not paticularly elegant!

[vba]
Public Sub MakeGame()
Dim rngCells As Range
Dim i As Long, j As Long
Dim lngCellValue As Long
Dim ablnHad() As Boolean

Set rngCells = ActiveSheet.Range("G2:J7")
ReDim ablnHad(0 To rngCells.Cells.Count - 1)

With rngCells
For i = 0 To 5
For j = 0 To 3
If i = 5 And j = 3 Then
lngCellValue = 0
.Cells(i + 1, j + 1).Value = lngCellValue
Else
Do
lngCellValue = Round(Rnd() * 23, 0)
If Not ablnHad(lngCellValue) And lngCellValue <> 0 Then
.Cells(i + 1, j + 1).Value = lngCellValue
ablnHad(lngCellValue) = True
Exit Do
End If
Loop
End If
Next j
Next i
End With
End Sub
[/vba]

[johnske]

That will do the job quite nicely alimcpill, and works well, thanks very much. I just renamed variables & tidied up a little to suit (copy below).

[VBA]Sub NewGame()
Dim MyRange As Range, i As Long, j As Long
Dim NewValueToUse As Long, UsedValues() As Boolean
Set MyRange = ActiveSheet.[G2:J7]
ReDim UsedValues(0 To MyRange.Cells.Count - 1)
With MyRange
For i = 1 To 6
For j = 1 To 4
If i = 6 And j = 4 Then
NewValueToUse = 0
Else
Do
'use system timer as new seed value
Randomize
NewValueToUse = Int((23 * Rnd) + 1)
If Not UsedValues(NewValueToUse) Then
.Cells(i, j) = NewValueToUse
UsedValues(NewValueToUse) = True
Exit Do
End If
Loop
End If
Next j
Next i
End With
End Sub[/VBA]

[Bob Phillips]

John,

Here is an alternative version using recursion

[VBA]
Private Const GAME_RANGE As String = "G2:J7"

Sub GameGenerator()
Dim iRow As Long
Dim iCol As Long

Range(GAME_RANGE)(Range(GAME_RANGE).Count) = 0
iRow = 2
iCol = 7
GenerateRandom iRow, iCol

End Sub

Private Sub GenerateRandom(pzRow As Long, pzCol As Long)
Dim nRandom As Long
Do
nRandom = Application.Run("ATPVBAEN.xla!randbetween", 1, 23)
Loop Until Application.CountIf(Range(GAME_RANGE), nRandom) = 0
Cells(pzRow, pzCol).Value = nRandom
pzRow = pzRow + 1
If pzRow = 8 Then
pzCol = pzCol + 1
pzRow = 2
End If
If pzRow < 7 Or pzCol < 10 Then
GenerateRandom pzRow, pzCol
End If

End Sub
[/VBA]

[johnske]

Thanks for that also Bob, now I have two choices.

[MWE]

Thanks for that also Bob, now I have two choices.

and something a little different [VBA]Sub test()
Dim I As Long
Dim J As Long
Dim K As Long
Dim R(23) As Long

Randomize
For I = 2 To 7
For J = 7 To 10
If I = 2 And J = 7 Then
Cells(I, J) = 0
R(0) = 1
Else
getNum:
K = Fix(Rnd() * 22 + 0.25) + 1
If R(K) = 1 Then GoTo getNum
R(K) = 1
Cells(I, J) = K
End If
Next J
Next I

End Sub[/VBA]