PDA

View Full Version : UDF randomize an array



BrianMH
03-24-2011, 05:14 AM
I used this for a bingo sheet. Just thought I would share since it might be needed. This will take an array and randomize with out repeating to another array of the same dimensions.


Option Base 1
Public Function RandomArray(rngPopulate As Range) As Variant
Dim CallerRows As Long
Dim CallerCols As Long
Dim Result() As Variant
Dim r As Range
Dim rws As Long
Dim clm As Long
Dim i As Long
Dim x As Long
Dim y As Long
Dim arrList() As Variant
Dim arrList2()
ReDim arrList(rngPopulate.Cells.Count)
ReDim arrList2(rngPopulate.Cells.Count)
i = 1

For Each r In rngPopulate.Cells
arrList(i) = r.Value
i = i + 1
Next r
For i = 1 To UBound(arrList2)
x = CLng(Int((rngPopulate.Cells.Count - 1 + 1) * Rnd + 1))
arrList2(i) = arrList(x)
While fnNotInArray(arrList2(), arrList2(i)) = True
x = CLng(Int((rngPopulate.Cells.Count - 1 + 1) * Rnd + 1))
arrList2(i) = arrList(x)
Debug.Print x
Wend

Next i
With Application.Caller
CallerRows = .Rows.Count
CallerCols = .Columns.Count
End With

i = 1
ReDim Result(1 To CallerRows, 1 To CallerCols)
For rws = 1 To CallerRows
For clm = 1 To CallerCols
Result(rws, clm) = arrList2(i)
i = i + 1
Next clm
Next rws
RandomArray = Result
End Function

Private Function fnNotInArray(arrValues() As Variant, varTest As Variant) As Boolean
Dim i As Long
Dim x As Long
Dim boolMatch As Boolean
boolMatch = False
x = 0
For i = 1 To UBound(arrValues)
If varTest = arrValues(i) And IsEmpty(arrValues(i)) = False Then x = x + 1
Next i
If x >= 2 Then boolMatch = True
fnNotInArray = boolMatch
End Function