Hi Steve,
The following code has 2 input boxes to allow you to select the matrix cells
and specify the number of random numbers.
The MsgBox simply establishes that the random numbers are in the Array.
The code uses a worksheet (Sheet2) to temporarily store the random
selections so that countif can be used to determine if random number has
already been used. Edit this sheet name if necessary.
You might need the Analysis Toolpak Add-In if not already installed for the
RANDBETWEEN function to work. (Analysis Toolpak is a standard Add-In feature
of Excel. See Help for how to install.)
The code will teminate if it experiences difficulty creating the required
number of unique random numbers from the matrix and the number of elements
requested.
Sub RandomNumbersArray()
Dim wsOutput As Worksheet
Dim rngMyMatrix As Range
Dim varElements As Variant
Dim i As Long
Dim lngRndCount As Long
Dim rndNumb As Long
Dim MyArray()
'Edit Sheet2 to your required temporary
'Storage sheet for the random numbers.
Set wsOutput = Sheets("Sheet2")
On Error Resume Next
Set rngMyMatrix = Application.InputBox _
(prompt:="Select number matrix", _
Title:="Matrix selection", Type:=8)
On Error GoTo 0
If rngMyMatrix Is Nothing Then
MsgBox "User cancelled." & vbCrLf & _
"Processing terminated."
Exit Sub
End If
varElements = Application.InputBox _
(prompt:="How many numbers required?", _
Title:="Number of elements", _
Default:=20, Type:=1)
If varElements = False Then
MsgBox "User cancelled." & vbCrLf & _
"Processing terminated."
Exit Sub
End If
wsOutput.Columns("A:A").ClearContents
wsOutput.Cells(1, 1) = "Rnd List"
With rngMyMatrix
For i = 1 To varElements
lngRndCount = 0
StartRandSelect:
rndNumb = WorksheetFunction _
.RandBetween(1, .Cells.Count)
If WorksheetFunction _
.CountIf(wsOutput.Columns("A:A"), _
.Cells(rndNumb)) = 0 Then
wsOutput.Cells(Rows.Count, "A") _
.End(xlUp).Offset(1, 0) _
= .Cells(rndNumb)
Else
lngRndCount = lngRndCount + 1
If lngRndCount > 10 Then
MsgBox "Difficulty creating " & _
"required number of random numbers." _
& vbCrLf & vbCrLf & _
"Processing will terminate."
Exit Sub
Else
GoTo StartRandSelect
End If
End If
Next i
End With
ReDim MyArray(i - 1)
MyArray = wsOutput.Range("A2:A" & i)
For i = 1 To UBound(MyArray)
MsgBox MyArray(i, 1)
Next
End Sub
