Best way to handle VBA's flaw in vectors of length 1

[JenniferMurphy]

This test code gets passed a range, like "B2:R3". It works fine unless it gets passed a range of length 1, like "B3:B3". Then it gets an error because VBA stupidly makes "B3:B3" a scalar and not a one-dimensional array of length 1. "B3" is a scalar. "B3:B3" is a vector.

Ok, enough ranting.

What do I need to do to this code so that aTemp will be a one-dimensional array of length 1 if passed "B3:B3"?

Function TestRng(rnTest As String)

Dim i As Long
Dim aTemp As Variant
aTemp = Range(rnTest).Value2

For i = 1 To UBound(aTemp)
  Debug.Print aTemp(i)
Next i

End Function

Thanks

 

[Kyle123]

I’m on my phone so can’t give you an example, but you can use the vartype function to test if aTemp is an array - you can then deal with it in the way that best fits

 

[kevin9999]

Try this Jennifer.

Function TestRng(ByRef rnTest As String)

    Dim aTemp
    ReDim aTemp(1 To 1, 1 To 1)
    aTemp = Range(rnTest)
    Debug.Print aTemp

End Function

 

[Siddharth Rout]

Jennifer. Couple of things.

1. A function is supposed to return something. In your case, you may want to use a Sub() instead of a Function(). In case you are planning to return an array to the function, then that is also possible.
2. Your test code will not run for even "B2:R3". When you assing a range to a Variant like that then it become a 2D array. In such a case `Debug.Print aTemp(i)` will fail but `Debug.Print aTemp(i,1)` will not.

One way to achieve what you want is to check the number of cells in the range and then create the array.

Option Explicit

Sub Sample()
    Debug.Print UBound(TestRng("B2:R2"))
    Debug.Print UBound(TestRng("B2:B2"))
End Sub

Function TestRng(rnTest As String) As Variant
    Dim i As Long
    Dim aTemp As Variant
    
    '~~> Check if the supplied range has more then 1 cell.
    If Range(rnTest).Cells.Count > 1 Then
        aTemp = Range(rnTest).Value2
        
        For i = LBound(aTemp) To UBound(aTemp)
            Debug.Print aTemp(i, 1)
        Next i
    Else
        '~~> Create a 1 D array
        ReDim aTemp(1 To 1)
        aTemp(1) = Range(rnTest).Value
        
        For i = LBound(aTemp) To UBound(aTemp)
            Debug.Print aTemp(i)
        Next i
    End If
    
    TestRng = aTemp
End Function

 

[kevin9999]

Inspired by @Siddharth Rout 's excellent solution, I thought I might tidy up my response a bit. Not much different from Sid's, but hate to leave my code half-baked

Sub test_arrays()
    Dim rnTest As String
    
    rnTest = "B3:B3"   '<~~ single cell test
    'rnTest = "B2:R3"    '<~~ range of cells test
    
    TestRng (rnTest)

End Sub

Function TestRng(ByRef rnTest As String)
    Dim aTemp, i As Long, j As Long
     
    If Range(rnTest).Cells.Count = 1 Then
        ReDim aTemp(1 To 1)
        aTemp(1) = Range(rnTest).Value
        For i = LBound(aTemp) To UBound(aTemp)
            Debug.Print aTemp(i)
        Next i
    Else
        aTemp = Range(rnTest)
        For i = 1 To UBound(aTemp, 1)
            For j = 1 To UBound(aTemp, 2)
                Debug.Print aTemp(i, j)
            Next j
        Next i
    End If
End Function

 

[Alex Blakenburg]

Haha , one can never have to many options.
I think the above is the more common approach but I like to put my single cell into a 2D array, so that I know I don't need to change anything in the rest of the code.
(@kevin9999 was heading there with his Post #3)

Function TestRng(ByRef rnTest As String)
    Dim aTemp, i As Long, j As Long
    
    aTemp = Range(rnTest)
    
    '--------------------------------------------------
    ' Convert single cell into the 2D array to normalise it
    '--------------------------------------------------
    If Not IsArray(aTemp) Then      
        ReDim aTemp(1 To 1, 1 To 1)
        aTemp(1, 1) = Range(rnTest).Value
    End If
    '--------------------------------------------------

    For i = 1 To UBound(aTemp, 1)
        For j = 1 To UBound(aTemp, 2)
            Debug.Print aTemp(i, j)
        Next j
    Next i

End Function

 

[Siddharth Rout]

Inspired by @Siddharth Rout 's excellent solution, I thought I might tidy up my response a bit. Not much different from Sid's, but hate to leave my code half-baked
...
[/CODE]

Yes I saw you storing it in a 2D array and I would have done that as well but my post was a direct answer to OPs requirements.

What do I need to do to this code so that aTemp will be a one-dimensional array of length 1 if passed "B3:B3"?

 

[JenniferMurphy]

Haha , one can never have to many options.
I think the above is the more common approach but I like to put my single cell into a 2D array, so that I know I don't need to change anything in the rest of the code.
(@kevin9999 was heading there with his Post #3)

It took me awhile to get my head around these various solutions. For me, your is the best because, as you say, once I get the source into a 2 dimensional array, I don't have to change anything in the rest of my code.

Here's my test solution.

Function Tester(ByRef rnTest As String)

Dim i As Long
Dim aTemp
Dim NumCells As Long

aTemp = Range(rnTest)
NumCells = Range(rnTest).Cells.Count
If NumCells = 1 Then
  ReDim aTemp(1 To 1, 1 To NumCells)
  aTemp(1, 1) = Range(rnTest).Value
End If

Tester = 0
For i = 1 To NumCells
  Debug.Print aTemp(1, i)
  Tester = Tester + aTemp(1, i)
Next i

End Function

PS: I don't know why you did a two-level For loop when you declared (ReDim'd) the first dimension to "1".

And here it is in action.

Weighted Ratings Demo.xlsx
	B	C	D	E	F
6	OneCell	6			6
7	TwoCells	6	3		9
8	ThreeCells	5	10	15	30
Sheet1

Cell Formulas
Range	Formula
F6:F8	F6	=tester(B6)

Thank you all. It would have taken me forever to come up with a solution and it probably would not have been this elegant.

Of course, if M$FT had just implemented it correctly in the first place.....

 

[JenniferMurphy]

I found a little oversight in the above code and I realized why you looped thru both the columns and the rows. Here's the improved code:

'================================================================================================
' This function demonstrates how to get around VBA stupid's way of handling single-cell
' ranges as scalars, when all multi-cell ranges come in as 2-dimensional arrays.
' All subsequent code can safely assume that it is always dealing with a 2-dimensional array.
' I got help from MrExcel in this thread:
' https://www.mrexcel.com/board/threads/best-way-to-handle-vbas-flaw-in-vectors-of-length-1.1233458/
'================================================================================================
Function Tester(ByRef rnTest As String)

Dim iRow As Long, iCol As Long  'Loop indices
Dim aTemp                       'Array that will contain range data
Dim NumCells As Long            'Total number of cells
Dim NumRows As Long             'Number of rows in the range
Dim NumCols As Long             'Number of columns in the range

aTemp = Range(rnTest)           'Load the range data into the array

NumCells = Range(rnTest).Cells.Count  'Get the total number of cells
If NumCells = 1 Then                  'If it's a single cell, VBA will make it a scalar
  ReDim aTemp(1 To 1, 1 To 1)           'Redimension it as a 1x1 array
  aTemp(1, 1) = Range(rnTest).Value     'Reload the single cell into the 2-dimensional array
'  aTemp(1, 1) = aTemp     '
End If

NumRows = UBound(aTemp, 1)        'Get the number of rows
NumCols = UBound(aTemp, 2)        'Get the mui,ner of columns
Tester = 0                        'Initialize the sum
For iRow = 1 To NumRows           'Loop thru the rows
  For iCol = 1 To NumCols           '.and the columns
'    Debug.Print aTemp(iRow, iCol)       'Show the value
    Tester = Tester + aTemp(iRow, iCol) 'Add the next value to the total
  Next iCol
Next iRow

End Function

And here the sheet that calls it:

Weighted Ratings Demo.xlsx
	B	C	D	E	F
6	OneCell	6			6
7	TwoCells	6	3		9
8	ThreeCells	5	10	15	30
9					45
Sheet1

Cell Formulas
Range	Formula
F6:F8	F6	=tester(B6)
F9	F9	=tester("C6:E8")

Again, thanks for the help.

 

[Alex Blakenburg]

Sorry Jennifer, I have a bit on at the moment and had meaning to reply.
As you discovered looping through both rows and columns just makes it more generic so that it should work in all cases.

Thanks for putting it together in a complete package to help others.