Related to my answer to this question, im using Chip Pearson's GetInfo function, where the arguments are:
=GetInfo(object, atribute)
However I want to use a Range as input for the object parameter and return the corresponding atribute for each cell in the input Range when executed as an array formula. Instead, it's returning the atribute of the input Range as a whole. For example, if I pass the atribute Interior.Color to the range A2:A5, it returns 0 since Interior.Color is not a valid atribute of a Range object. My expected result is an Array with the Interior.Color atribute of each cell in the A2:A5 range.
I wrote this separate function to handle this, and currently it's working but it's very inefficient since it's looping over every cell in the Range object. Instead I'd like to translate each Cell Item of the Range object to an Array and loop over it.
Original GetInfo function, which I left untouched:
Function GetInfo(TopObj As Variant, PropertySpec As Variant) As Variant
Dim PropArr As Variant ' array returned by Split of object tree
Dim ItemSpec As Variant ' item in collection
Dim Obj As Object ' generic Object to hold
'the top-level object (ws,wb,range, or app)
Dim Ndx As Long ' loop counter
Dim Pos1 As Integer ' used to find the Item specified in collection objects
Dim Pos2 As Integer ' used to find the Item specified in collection objects
Dim TempObj As Object
'
' split the object/property spec
'
PropArr = Split(PropertySpec, ".")
'
' If Rng is an object, then it must be a Range. That's the only
' type of object you pass from a cell.
'
If IsObject(TopObj) Then
Set Obj = TopObj
Else
'
' Otherwise, it better be one of the following strings. Else,
' blow up the user.
'
Select Case UCase(TopObj)
Case "APP", "APPLICATION"
Set Obj = Application
Case "WB", "TWB", "THISWORKBOOK", "WORKBOOK"
Set Obj = ThisWorkbook
Case "WS", "TWS", "THISWORKSHEET", "WORKSHEET"
Set Obj = Application.Caller.Parent
Case Else
GetInfo = CVErr(xlErrValue)
End Select
End If
For Ndx = LBound(PropArr) To UBound(PropArr) - 1
'
' this block of code is for handling items of a collection
'
Pos1 = InStr(1, PropArr(Ndx), "(")
If Pos1 > 0 Then
'
' if we've found the open paren, we're dealing with an
' item of a collection. now, find the closing paren.
'
Pos2 = InStr(1, PropArr(Ndx), ")")
ItemSpec = Mid(PropArr(Ndx), Pos1 + 1, Pos2 - Pos1 - 1)
If IsNumeric(ItemSpec) Then
' numeric -- going by index number
ItemSpec = CLng(ItemSpec)
Else
' string -- going by key name, so get rid of any quotes.
ItemSpec = Replace(ItemSpec, """", "")
End If
'
' call the Item method of the collection object.
'
Set Obj = CallByName(Obj, Mid(PropArr(Ndx), 1, Pos1 - 1), _
VbGet, ItemSpec)
Else
'
' we're not dealing with collections. just get the object.
'
Set Obj = CallByName(Obj, PropArr(Ndx), VbGet)
End If
Next Ndx
'
' get the final property (typically 'name' or 'value' of the object tree)
'
If IsObject(Obj) Then
GetInfo = CallByName(Obj, PropArr(UBound(PropArr)), VbGet)
End If
End Function
my aditional Function:
Public Function getArrayInfo(rng As Range, atr As String) As Variant
Dim temp As Excel.Range
Dim out() As Variant
Dim i As Long
ReDim out(1 To rng.Rows.Count, 1 To 1)
Set temp = Intersect(rng, ActiveSheet.UsedRange) 'Intersect UsedRange to help when using whole row/column as input
For i = 1 To temp.Cells.Count 'inefficient loop over a Range object
out(i, 1) = GetInfo(temp.Cells(i, 1), atr)
Next i
getArrayInfo = out
End Function
Attached is an example where I use the getInfo function over an array and it returns the parameter interior.Color of the whole array, which is undefined and returns 0. to the right, I have my function where I do get the expected result, but as I mentioned, runs very slow over large datasets.
