Solved: Single member array problem

[mdmackillop]

I'm using this code to return an array based on a range. It handles Empty ranges, and 2 or more elements but fails with a single element. I can't puzzle out why. Any ideas?

[VBA]
Sub Arrays()
Dim arr
Dim Ranges(), R
Ranges = Array(Range("B4"), Range("D4"), Range("F4"))
'Pass range start
For Each R In Ranges
x = 12
'assign to variable
arr = TestArray(R)
'loop through elements
For i = 1 To UBound(arr)
'write results
Cells(x, R.Column) = arr(i, 1)
x = x + 1
Next i
Next R
End Sub

Function TestArray(MyRng) As Variant
Dim rng As Range
'Get range
Set rng = Range(MyRng, Cells(Rows.Count, MyRng.Column).End(xlUp))
'Check if Range is empty
If rng(1).Row = 3 Then
'If empty
TestArray = Array()
Else
'If not empty
TestArray = rng.Value
End If
End Function


[/VBA]

[Norie]

arr isn't an Array when it only has 1 item.

To check for an array use the IsArray function and act accordingly.

[GTO]

Hi Malcom,

This may or may not be considered effective/efficient, but I'm trying to improve at arrays, so hope you won't mind.

After stepping thru a couple of times and reading Norie's comment about arr not being an array if only holding a single val, my thought was to insist that arr is an array. I could not see a way of building it w/o a loop...

Not sure whether good, not so stellar, or, "Mark, if you're painting, you need to open the windows, yer stoned...", but seems to work.

Mark

Using the data layout as shown in post #1 (Arrays.xls):
[vba]
Sub Arrays()
Dim x As Long
Dim i As Long
Dim lRows As Long
Dim arr As Variant
Dim R As Variant
Dim Ranges() As Variant
Dim rng As Range

Ranges = Array(Range("B4"), Range("D4"), Range("F4"))

For Each R In Ranges
x = 12
'// I set the range, so I could get the row count (or 1 if //
'// 0) and redimension arr to an array //
Set rng = Range(R, Cells(Rows.Count, R.Column).End(xlUp))
lRows = IIf(rng(1).Row = 3, 1, rng.Rows.Count)
ReDim arr(1 To lRows, 1 To 1)
arr = TestArray(rng)

'// If empty, ubound will be -1 //
If UBound(arr, 1) > 0 Then
Range(Cells(12, R.Column), Cells(12 + lRows - 1, R.Column)) = arr
End If
Next
End Sub

Function TestArray(rngPassed) As Variant()
Dim i As Long
Dim rCell As Range
Dim aryTmp() As Variant

If rngPassed(1).Row = 3 Then
ReDim aryTmp(1 To 1, 1 To 1)
TestArray = Array()
Exit Function
Else
ReDim aryTmp(1 To rngPassed.Rows.Count, 1 To 1)
i = 0
For Each rCell In rngPassed
i = i + 1
aryTmp(i, 1) = rCell.Value
Next
End If
TestArray = aryTmp
End Function
[/vba]

[Norie]

Mark

What result(s) do you get when you use IsArray?
[vba]
Sub Arrays()
Dim arr
Dim Ranges(), R
Ranges = Array(Range("B4"), Range("D4"), Range("F4"))
'Pass range start
For Each R In Ranges
x = 12
'assign to variable
arr = TestArray(R)

If IsArray(arr) Then
MsgBox "Congratulations it's an array!"
Else
MsgBox "Sorry, not an array, bad luck!"
Exit Sub
End If
'loop through elements
For i = 1 To UBound(arr)
'write results
Cells(x, R.Column) = arr(i, 1)
x = x + 1
Next i
Next R
End Sub
Function TestArray(MyRng) As Variant
Dim rng As Range
'Get range
Set rng = Range(MyRng, Cells(Rows.Count, MyRng.Column).End(xlUp))
'Check if Range is empty
If rng(1).Row = 3 Then
'If empty
TestArray = Array()
Else
'If not empty
TestArray = rng.Value
End If
End Function
[/vba]

[GTO]

Well, as you stated it's not an array if only one item, so it fails at For i = 1 To Ubound(arr).

Maybe I'm being thick-headed, but how are you suggesting to return a value if the range is only one cell?

Did you try #3?

Out for now, but will check later,

Mark

[Norie]

Mark

To tell you the truth I've not looked closely at the rest of the code and what it does.

All I'm saying is it isn't an array, you can check that using IsArray and then act accordingly.
[vba]
If IsArray(arr) Then
' do the array thing
Else
' do the non-array thing
End If
[/vba]

[mdmackillop]

Norie,
The code creates the arrays (non-arrays) and tries to output the values below the data.

Mark,
I'm more inclined to test Rng size for 1 or maybe ubound(arr) to return a single value. This will save looping.

Obviously an array can contain only one member
arr = array("one")
but my method of handling the variant is not creating an array which can be handled in the same way as a 2+ element array.

[Norie]

Yes an array can contain only 1 item but not if it's created the way you are creating them.

[GTO]

Howdy Malcom,

Mark,
I'm more inclined to test Rng size for 1 or maybe ubound(arr) to return a single value. This will save looping.

...but my method of handling the variant is not creating an array which can be handled in the same way as a 2+ element array.

I did not quite grasp that part, but I think that's okay.

Well Mate, I might not be the brightest bulb in the light store, but I'm nothing if not obstinate/stubborn...

How's this?

[vba]
Option Explicit

Sub Arrays_2()
Dim Ranges()
Dim R As Variant
Dim x As Long
Dim rng As Range
Dim arr As Variant
Dim lRows As Long

Ranges = Array(Range("B4"), Range("D4"), Range("F4"))

For Each R In Ranges
x = Cells(Rows.Count, R.Column).End(xlUp).Row + 3
Set rng = Range(R, Cells(Rows.Count, R.Column).End(xlUp))

lRows = IIf(rng(1).Row = 3, 1, rng.Rows.Count)
If lRows = 1 Then ReDim arr(1 To 1)
arr = TestArray_2(rng)

If UBound(arr) > 0 Then Range(Cells(x, R.Column), Cells(x + lRows - 1, R.Column)) = arr
Next
End Sub

Function TestArray_2(rPassed) As Variant()
Dim ary(1 To 1)

If rPassed(1).Row = 3 Then
TestArray_2 = Array()
ElseIf rPassed.Rows.Count = 1 Then
ary(1) = rPassed.Value
TestArray_2 = ary
Else
TestArray_2 = rPassed.Value
End If
End Function
[/vba]

The array is filled in one wack, as is the resultant range. Please note that I changed x, just so as I could test on a larger range/array.

I did test against my previous, and by golly, with a couple k rows, appears 3 to 4 times faster.

Hope this is better,

Mark

[mdmackillop]

Yes an array can contain only 1 item but not if it's created the way you are creating them.

I think I said that.

[Tommy]

Hi MD,

I think it is because you are returning a variant which will be a value if you only have 1 item.

But this works.

[VBA]
Sub Arrays()
Dim arr
Dim Ranges(), R
Ranges = Array(Range("B4"), Range("D4"), Range("F4"))
'Pass range start
For Each R In Ranges
x = 12
'assign to variable
arr = TestArray(R)
'loop through elements
On Error Resume Next
'if the array is just one value make it throw an error
If UBound(arr) Then x = 12
If Err.Number = 0 Then
For i = 1 To UBound(arr)
'write results
Cells(x, R.Column) = arr(i, 1)
x = x + 1
Next i
Else
Err.Clear
Cells(x, R.Column) = arr
End If
Next R
End Sub
Function TestArray(MyRng) As Variant
Dim rng As Range
'Get range
Set rng = Range(MyRng, Cells(Rows.Count, MyRng.Column).End(xlUp))
'Check if Range is empty
If rng(1).Row = 3 Then
'If empty
TestArray = Array()
Else
'If not empty
TestArray = rng.Value
End If
End Function
[/VBA]

[Paul_Hossler]

If you don't required that Arrays be used, another way would be to stick with explictly Dim-ed Ranges


[vba]
Option Explicit
Sub Arrays()
Dim Ranges As Variant, R As Range, rCell As Range
Dim i As Long, j As Long, x As Long

Ranges = Array(Range("B4"), Range("D4"), Range("F4"))

For j = LBound(Ranges) To UBound(Ranges)

'need the extra ( ) around Ranges(j) to force type casting
'since Ranges is a variant to allow = Array (...)
Set R = TestArray((Ranges(j)))

If Not R Is Nothing Then

x = 12

For Each rCell In R.Columns(1).Cells
Cells(x, Ranges(j).Column).Value = rCell.Value
x = x + 1
Next
End If

Next j
End Sub
Function TestArray(MyRng As Range) As Range
Dim rng As Range
'Get range
Set rng = Range(MyRng, Cells(Rows.Count, MyRng.Column).End(xlUp))
'Check if Range is empty
If rng(1).Row = 3 Then
'If empty
Set TestArray = Nothing
Else
'If not empty
Set TestArray = rng
End If
End Function
[/vba]

Paul

[mdmackillop]

Thanks all,
A few choices to work from. I had started with hard coded arrays and changed to filling them from ranges for flexibility. The single item failure came from there.
Thanks to Norie for spotting the initial problem, any the rest for solutions!
Regards
Malcolm