View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Jim Rech[_2_] Jim Rech[_2_] is offline
external usenet poster
 
Posts: 533
Default Putting large array into a worksheet

With a slight modification to Chip's routine (see below) you can have it
return a 'vertical' array rather than a 'horizontal'. Then you do not need
to transpose it:


Set targetrng = Range("A2").Resize(m)

--
Jim

''Creates a many rows by 1 column array
Public Function UniqueRandomLongs(Minimum As Long, Maximum As Long, _
Number As Long, Optional ArrayBase As Long = 1, _
Optional Dummy As Variant) As Variant

Dim SourceArr() As Long
Dim ResultArr() As Long
Dim SourceNdx As Long
Dim ResultNdx As Long
Dim TopNdx As Long
Dim Temp As Long

If Minimum Maximum Then
UniqueRandomLongs = Null
Exit Function
End If
If Number (Maximum - Minimum + 1) Then
UniqueRandomLongs = Null
Exit Function
End If
If Number <= 0 Then
UniqueRandomLongs = Null
Exit Function
End If

Randomize

ReDim SourceArr(Minimum To Maximum)
ReDim ResultArr(ArrayBase To (ArrayBase + Number - 1), 1)

For SourceNdx = Minimum To Maximum
SourceArr(SourceNdx) = SourceNdx
Next SourceNdx

TopNdx = UBound(SourceArr)
For ResultNdx = LBound(ResultArr) To UBound(ResultArr)
SourceNdx = Int((TopNdx - Minimum + 1) * Rnd + Minimum)
ResultArr(ResultNdx, 1) = SourceArr(SourceNdx)
Temp = SourceArr(SourceNdx)
SourceArr(SourceNdx) = SourceArr(TopNdx)
SourceArr(TopNdx) = Temp
TopNdx = TopNdx - 1
Next ResultNdx
UniqueRandomLongs = ResultArr

End Function


"goaljohnbill" wrote in message
...
|I have a program creating an array using Chip Pearsons excellent
| UniqueRandomLongs function. I found some other code in here that will
| put it in a worksheet in 1 column. This method seems to have a max of
| 256 items (# of columns in excel I suppose). I would like to be able
| to do more than that if possible. Could anyone help me out? The
| current code Im using for placement is:
|
| Dim Res As Variant
| Dim Min As Long
| Dim Max As Long
| Dim N As Long
|
| '''''''''''''''''''''''''''''
| ' Get N non-duplicated Longs
| ' each of which is between
| ' 1 and Max.
| '''''''''''''''''''''''''''''
| Min = 1
| Max = reccount
| N = recpct
|
| Res = UniqueRandomLongs(Minimum:=Min, Maximum:=Max, Number:=N)
|
| If IsArrayAllocated(Res) = False Then
| Debug.Print "Error from UniqueRandomLongs."
| Else
| arr = Res
| m = UBound(arr, 1) - LBound(arr, 1) + 1
| Set targetrng = Range("A2").Resize(, m)
| targetrng.Value = arr
| Range("A2:A" & m).Value = Application.Transpose(arr)
|
| End If