Returning single/multiple values from array function

[Ryan Poth]

Thanks in advance for any help provided for this problem
which has been bugging me for quite some time.

I have various functions that return arrays of varying
sizes. My problem is that, if my function returns only one
value, Excel replicates that value over the entire
resulting range.

I'll try and explain further with a simple example. I've
created a function that looks at a range of numbers and
returns an array containing only the positive numbers.
I've included the source code below for reference.

If the source range contains at least two positive
numbers, it works fine (the two positive numbers are
returned and the remaining cells in the target range
return #N/A, which I can deal with).

However, if there is only a single positive number in the
source range, that number is returned in each and every
cell in the target range.

In other words, if my source range contains the following:
1
-1
2
-3

I get:
1
2
#N/A
#N/A

But if my source range contains the following:
1
-1
-2
-3

I get:
1
1
1
1

The source code for the sample function is as follows:

Function Test(Source As Range) As Variant

Dim SourceRow As Integer, ResultRow As Integer
Dim Result() As Double
ReDim Result(100)

For SourceRow = 1 To Source.Rows.Count
If Source.Cells(SourceRow, 1).Value > 0 Then
Result(ResultRow) = Source.Cells(SourceRow, 1).Value
ResultRow = ResultRow + 1
End If
Next SourceRow

ReDim Preserve Result(ResultRow - 1
Test = Application.Transpose(Result)
End Function

Apologies for the long-winded explanation, but I wanted to
be as clear as possible.

Thanks,
Ryan

 

[Don P]

Ryan,
Don't know if this will work for you. All numbers that are not positive
return as zero.

Function Test(Source As Range) As Variant
Dim SourceRow As Integer, ResultRow As Integer
Dim Result(1 To 100)
ResultRow = 1
For SourceRow = 1 To Source.Rows.Count
If Source.Cells(SourceRow, 1).Value > 0 Then
Result(ResultRow) = Source.Cells(SourceRow, 1).Value
ResultRow = ResultRow + 1
End If
Next SourceRow
Test = Application.Transpose(Result)
End Function

Don Pistulka

 

[Tom Ogilvy]

Change your function to return Variant and adjust the output as shown

Function Test(Source As Range) As Variant

Dim SourceRow As Integer, ResultRow As Integer
Dim Result() As Variant
ReDim Result(100)

For SourceRow = 1 To Source.Rows.Count
If Source.Cells(SourceRow, 1).Value > 0 Then
Result(ResultRow) = Source.Cells(SourceRow, 1).Value
ResultRow = ResultRow + 1
End If
Next SourceRow
If ResultRow < 3 Then
ReDim Preserve Result(1)
Result(1) = CVErr(xlErrNA)
Else
ReDim Preserve Result(ResultRow - 1)
End If
Test = Application.Transpose(Result)
End Function

Regards,
Tom Ogilvy

 

[Tom Ogilvy]

The 3 should be a 2

Function Test(Source As Range) As Variant

Dim SourceRow As Integer, ResultRow As Integer
Dim Result() As Variant
ReDim Result(100)

For SourceRow = 1 To Source.Rows.Count
If Source.Cells(SourceRow, 1).Value > 0 Then
Result(ResultRow) = Source.Cells(SourceRow, 1).Value
ResultRow = ResultRow + 1
End If
Next SourceRow
If ResultRow < 2 Then
ReDim Preserve Result(1)
Result(1) = CVErr(xlErrNA)
Else
ReDim Preserve Result(ResultRow - 1)
End If
Test = Application.Transpose(Result)
End Function

 

[Ryan Poth]

Tom,
What a good idea. I'm ashamed I hadn't thought of it, but
then that's why I love these newsgroups. Thanks very much
again.
Ryan