Putting large array into a worksheet

[goaljohnbill]

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

 

[Jim Rech]

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


|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

 

[goaljohnbill]

Jim when i run the sub with the changes you indicated the values in my
destination sheet are the correct size (# of records) but they are all
zero. Thanks for the time you are spending on this by the way

 

[Jim Rech]

Try this new version of Chip's function:

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 To 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

 

[Alan Beban]

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

What is the point of the following two lines from your code? If you
omit them, don't you get the result you want?

Set targetrng = Range("A2").Resize(, m)
targetrng.Value = arr

Alan Beban

 

[goaljohnbill]

That did it Jim thanks a million!

I dont know the point of those 2 lines. Im willing to admit that at
least 90% of this code is beyond me, it is copy and paste hackery. I
really only know that it does what i want now that ive made these
changes.
I copied the section in the last else nearly verbatim from a reply you
made to a different individual in june 2006 that i found while
searching for the answer to my question.
I think i will run it without those lines at some point now and see
what it does.


Thanks
john

 

[Jim Rech]

I dont know the point of those 2 lines.

Yes you do! I explained it!<g>

Chip's function returns a horizontal array:

xxxx

You want it to be vertical:

x
x
x
x

Your code tried to transpose the first to the second but ran into the 256
column limit.

So my revised function returns a

x
x
x
x

array so you don't have to transpose it. You knew that, fess up!


--
Jim
| That did it Jim thanks a million!
|
| I dont know the point of those 2 lines. Im willing to admit that at
| least 90% of this code is beyond me, it is copy and paste hackery. I
| really only know that it does what i want now that ive made these
| changes.
| I copied the section in the last else nearly verbatim from a reply you
| made to a different individual in june 2006 that i found while
| searching for the answer to my question.
| I think i will run it without those lines at some point now and see
| what it does.
|
|
| Thanks
| john

 

[Alan Beban]

That did it Jim thanks a million!

I dont know the point of those 2 lines. Im willing to admit that at
least 90% of this code is beyond me, it is copy and paste hackery. I
really only know that it does what i want now that ive made these
changes.
I copied the section in the last else nearly verbatim from a reply you
made to a different individual in june 2006 that i found while
searching for the answer to my question.
I think i will run it without those lines at some point now and see
what it does.


Thanks
john

Can you post a link to that June 2006 posting? Or the subject matter so
I can Google it?

Thanks,
Alan Beban

 

[Alan Beban]

Yes you do! I explained it!<g>

Chip's function returns a horizontal array:

xxxx

You want it to be vertical:

x
x
x
x

Your code tried to transpose the first to the second but ran into the 256
column limit.

So my revised function returns a

x
x
x
x

array so you don't have to transpose it. You knew that, fess up!

I'm lost! No question that one way to get the result is to return a
vertical array from a function like Chip's that returns a horizontal
array. But the code snippet was

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)

The problem with the code is not in transposing the horizontal array to
a vertical array; there's no 256 element limit on a horizontal array,
nor is there such a limit on transposing such a horizontal array to a
vertical array, nor on depositing the transposed vertical array to a
vertical range.

arr = Res
m = UBound(arr, 1) - LBound(arr, 1) + 1
Range("A2:A" & m).Value = Application.Transpose(arr)

gets you there without involvement of the 256 column limit.

The limit simply prevents the resizing of the worksheet range to more
than 256 columns, but there's no need to try to put the array into a
horizontal range before dumping its transpose into a vertical range. In
short, there is no point including the two lines

Set targetrng = Range("A2").Resize(, m)
targetrng.Value = arr

Alan Beban