Harlan Grove wrote: ...
. . . As I mentioned previously, by design no checking is
provided to insure that each element of InputRange is of a type that
will be accepted by an array of the type of InputArray; that is left to
errorhandler. One reason, among others, is that otherwise, as above,
an additional call is required within the loop for each element of
InputRange.
...
You're checking whether InputArray is an array of object references, but you see
no benefits to checking whether individual entries in InputRange are objects?
And you base this on the desirability of not checking the types of any entry in
InputRange.
As for the need for additional calls, if more calls provide more functionality,
it's a design trade-off. So you seem to be taking the position that the
functionality provided by Assign as you have it so far is ideal even though it
won't handle assigning an any valid InputRange (no more than 2 non-hierarchical
dimensions of variants) to an array of variants.
The only time Assign could do anything useful when InputArray is an array of
object references is when InputRange is also an array of object references.
Otherwise, the error handler would kick in. Even when both are arrays of object
references, when would Assign ever be preferable to
Dim InputArray As Variant, InputRange(...) As SomeObjectType
'initialize InputRange
InputArray = InputRange
?!!
You must have some idea when Assign would be useful when InputArray is an array
of object references. Don't you?
I don't understand your discussion above about built-in VBA
syntax/semantics (I'm not sure what syntax/semantics you're referring
to) being quicker than using Assign to assign an array of variants to
another array of variants. . . .
See above. Precisely *NOT* assignment to another *ARRAY* of variants but to a
variant, as in 'Dim x As Variant', not 'Dim x() As Variant'.
. . . The function isn't proposed for use in
assigning an array of variants to another array of variants; it's
proposed for assigning ranges and arrays to non-Variant() arrays. I.e.,
cases, admittedly not all, in which the "Can't assign to array" error
message is normally encountered. Indeed, to assign your Variant() array
v above to a Variant() array arr, all that's needed is arr = v; Assign
isn't relevant to that case. Unless once again, I'm missing some point.
If so, perhaps you could make the point more clearly, without so much
clutter.
OK, it seems your original conception was that Assign would handle assigning
ranges to arrays of nonvariant and nonobject type. For example, assigning a
range to an array of integers (along with all the implicit conversion and
rounding that may entail). Then you seem to have thought about adding support
for 1D and 2D arrays as well as ranges. Then you seem to have thought that such
arrays could contain object references. Classic feature creep.
Assigning anything to an array of variants is pointless compared to assinging
exactly the same thing to a single, non-array variant (see example above if
you're still unclear on the concept). In that sense, Assign provides no benefits
when InputArray is an array of variants. It also provides no clear benefits when
assigning arrays of objects to arrays of objects. Maybe I've been too sheltered,
but when I need arbitrary collections of objects, I use Collection objects
rather than arrays of objects. When are arrays of objects useful? How often do
you use them?
Anyway, FTHOI, here's how I'd do it. Note it doesn't allow objects at all, it
requires that the target array start off empty (up to the caller to Erase it if
necessary) and it does lightweight error checking by entry. Oh, and it also
handles 0D through 6D nonhierarchical arrays.
Function ct(ByRef a As Variant, ByRef b As Variant) As Boolean
Dim n As Long, x As Variant
Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long, i5 As Long, i6 As Long
ct = True 'error exit status is TRUE, success is FALSE
If IsObject(a) Or IsObject(b) Then Exit Function
If Not (IsArray(a) And IsArray(b)) Then 'both scalars
Select Case TypeName(b)
Case "Boolean": b = CBool(a)
Case "Byte": b = CByte(a)
Case "Currency": b = CCur(a)
Case "Date": b = CDate(a)
Case "Decimal": b = CDec(a)
Case "Double": b = CDbl(a)
Case "Integer": b = CInt(a)
Case "Long": b = CLng(a)
Case "Single": b = CSng(a)
Case "String": b = CStr(a)
Case "Variant": b = CVar(a)
Case Else: Exit Function 'impossible condition - error
End Select
ct = False 'success if any built-in scalar type
ElseIf IsArray(a) And IsArray(b) Then
On Error Resume Next
x = UBound(b, 1)
If Err.Number = 0 Then
Exit Function 'b must be empty!!
Else
Err.Clear
End If
n = 1
Do 'forever
x = UBound(a, n + 1)
If Err.Number <> 0 Then Exit Do
n = n + 1
Loop
Err.Clear
On Error GoTo 0
Select Case n
Case 1:
ReDim b( _
LBound(a, 1) To UBound(a, 1) _
)
For Each x In b
Exit For
Next x
For i1 = LBound(a, 1) To UBound(a, 1)
If Not ct(a(i1), x) Then
b(i1) = x
Else
Exit Function 'error converting a(...)
End If
Next i1
Case 2:
ReDim b( _
LBound(a, 1) To UBound(a, 1), _
LBound(a, 2) To UBound(a, 2) _
)
For Each x In b
Exit For
Next x
For i1 = LBound(a, 1) To UBound(a, 1)
For i2 = LBound(a, 2) To UBound(a, 2)
If Not ct(a(i1, i2), x) Then
b(i1, i2) = x
Else
Exit Function 'error converting a(...)
End If
Next i2
Next i1
Case 3:
ReDim b( _
LBound(a, 1) To UBound(a, 1), _
LBound(a, 2) To UBound(a, 2), _
LBound(a, 3) To UBound(a, 3) _
)
For Each x In b
Exit For
Next x
For i1 = LBound(a, 1) To UBound(a, 1)
For i2 = LBound(a, 2) To UBound(a, 2)
For i3 = LBound(a, 3) To UBound(a, 3)
If Not ct(a(i1, i2, i3), x) Then
b(i1, i2, i3) = x
Else
Exit Function 'error converting a(...)
End If
Next i3
Next i2
Next i1
Case 4:
ReDim b( _
LBound(a, 1) To UBound(a, 1), _
LBound(a, 2) To UBound(a, 2), _
LBound(a, 3) To UBound(a, 3), _
LBound(a, 4) To UBound(a, 4) _
)
For Each x In b
Exit For
Next x
For i1 = LBound(a, 1) To UBound(a, 1)
For i2 = LBound(a, 2) To UBound(a, 2)
For i3 = LBound(a, 3) To UBound(a, 3)
For i4 = LBound(a, 4) To UBound(a, 4)
If Not ct(a(i1, i2, i3, i4), x) Then
b(i1, i2, i3, i4) = x
Else
Exit Function 'error converting a(...)
End If
Next i4
Next i3
Next i2
Next i1
Case 5:
ReDim b( _
LBound(a, 1) To UBound(a, 1), _
LBound(a, 2) To UBound(a, 2), _
LBound(a, 3) To UBound(a, 3), _
LBound(a, 4) To UBound(a, 4), _
LBound(a, 5) To UBound(a, 5) _
)
For Each x In b
Exit For
Next x
For i1 = LBound(a, 1) To UBound(a, 1)
For i2 = LBound(a, 2) To UBound(a, 2)
For i3 = LBound(a, 3) To UBound(a, 3)
For i4 = LBound(a, 4) To UBound(a, 4)
For i5 = LBound(a, 5) To UBound(a, 5)
If Not ct(a(i1, i2, i3, i4, i5), x) Then
b(i1, i2, i3, i4, i5) = x
Else
Exit Function 'error converting a(...)
End If
Next i5
Next i4
Next i3
Next i2
Next i1
Case 6:
ReDim b( _
LBound(a, 1) To UBound(a, 1), _
LBound(a, 2) To UBound(a, 2), _
LBound(a, 3) To UBound(a, 3), _
LBound(a, 4) To UBound(a, 4), _
LBound(a, 5) To UBound(a, 5), _
LBound(a, 6) To UBound(a, 6) _
)
For Each x In b
Exit For
Next x
For i1 = LBound(a, 1) To UBound(a, 1)
For i2 = LBound(a, 2) To UBound(a, 2)
For i3 = LBound(a, 3) To UBound(a, 3)
For i4 = LBound(a, 4) To UBound(a, 4)
For i5 = LBound(a, 5) To UBound(a, 5)
For i6 = LBound(a, 6) To UBound(a, 6)
If Not ct(a(i1, i2, i3, i4, i5, i6), x) Then
b(i1, i2, i3, i4, i5, i6) = x
Else
Exit Function 'error converting a(...)
End If
Next i6
Next i5
Next i4
Next i3
Next i2
Next i1
Case Else: Exit Function 'impossible condition - error
End Select
ct = False 'success if any built-in scalar type
'Else -- mixed references - unsupported - error
End If
End Function
Sample usage:
Sub foo()
Dim x() As Byte
If ct(Range("A1:C5").Value, b) Then
MsgBox "FUBAR!"
Exit Sub
End If
'other stuff using b
End Sub
