Bug in the code I posted. Use the following instead:
Function RandsFromRange(InputRange As Range, GetNum As Long) As Variant
Dim ResultArr() As Variant
Dim SourceArr() As Variant
Dim TopNdx As Long
Dim ResultNdx As Long
Dim SourceNdx As Long
Dim Temp As Variant
If InputRange.Columns.Count > 1 And InputRange.Rows.Count > 1 Then
RandsFromRange = CVErr(xlErrRef)
Exit Function
End If
If GetNum > InputRange.Cells.Count Then
RandsFromRange = CVErr(xlErrValue)
Exit Function
End If
ReDim ResultArr(1 To InputRange.Cells.Count)
SourceArr = InputRange.Value
Randomize
TopNdx = UBound(ResultArr)
For ResultNdx = LBound(ResultArr) To UBound(ResultArr)
SourceNdx = Int(TopNdx * Rnd + 1)
ResultArr(ResultNdx) = SourceArr(SourceNdx, 1)
Temp = SourceArr(SourceNdx, 1)
SourceArr(SourceNdx, 1) = SourceArr(TopNdx, 1)
SourceArr(TopNdx, 1) = Temp
TopNdx = TopNdx - 1
Next ResultNdx
If IsObject(Application.Caller) = True Then
If TypeOf Application.Caller Is Excel.Range Then
If Application.Caller.Columns.Count = 1 Then
RandsFromRange = Application.Transpose(ResultArr)
Else
RandsFromRange = ResultArr
End If
Else
' do nothing
End If
Else
RandsFromRange = ResultArr
End If
End Function
--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting
www.cpearson.com
(email on the web site)