Output from Class to Range

Finding Comparables Setup
Filling Classes and Finding Specific Instances
Filtering and Sorting Classes

In this final installment, I look at the code to write a class module to a range. That is represented by the last two lines of this controlling procedure:

Sub GetComperablesByState()
    Dim clsCompanies As CCompanies
    Dim clsWisky As CCompanies
    Dim vaOutput As Variant
    Dim clsFocus As CCompany
    ‘Fill all companies
   Set clsCompanies = New CCompanies
    clsCompanies.Fill Sheet1.Range(“A2:D201”)
    ‘identify the one I care about
   Set clsFocus = clsCompanies.FindByName(“Monarch”)
    ‘get only those companies in the same state
   Set clsWisky = clsCompanies.FilterByState(clsFocus.State)
    ‘sort them by sales
    ‘get an array of the 3 below and 3 above
   vaOutput = clsWisky.WriteComparables(clsFocus, 3)
    ‘write it to a range
   Sheet1.Range(“G1”).Resize(UBound(vaOutput, 1), UBound(vaOutput, 2)).Value = vaOutput
End Sub

A quick and efficient way to write data to a worksheet, typically a slow process, is to assign an array to the Value property of a Range. This is done in two steps in the above procedure. The first step is to pull certain data out of the class into the Variant Array vaOutput. The second step is to assign that Variant Array to the Value property of a range.

To get the data into an array, I wrote the WriteComparables property. It returns a Variant (a data type that can be anything), which in this case will be an array. The second argument, lRange, is how I tell the property how many companies before and after the focus company I want to return, in this case 3.

Public Property Get WriteComparables(clsFocus As CCompany, lRange As Long) As Variant
    Dim aReturn() As Variant
    Dim lFocus As Long
    Dim i As Long
    Dim clsCurr As CCompany
    Dim lCount As Long
    Dim lStart As Long, lEnd As Long
    lFocus = clsFocus.Index
    If lFocus > lRange Then
        lStart = -lRange
        lStart = -lFocus + 1
    End If
    If lFocus < Me.Count – (lRange – 1) Then
        lEnd = lRange
        lEnd = Me.Count – lFocus
    End If
    ReDim aReturn(1 To (lEnd – lStart) + 2, 1 To 4)
    aReturn(1, 1) = “Company”
    aReturn(1, 2) = “City”
    aReturn(1, 3) = “State”
    aReturn(1, 4) = “Sales”
    lCount = 1
    For i = lStart To lEnd
        Set clsCurr = Me.Company(lFocus + i)
        lCount = lCount + 1
        If clsCurr.CompanyID = clsFocus.CompanyID Then
            aReturn(lCount, 1) = “*” & clsCurr.CompanyName
            aReturn(lCount, 1) = clsCurr.CompanyName
        End If
        aReturn(lCount, 2) = clsCurr.City
        aReturn(lCount, 3) = clsCurr.State
        aReturn(lCount, 4) = clsCurr.Sales
    Next i
    WriteComparables = aReturn
End Property

The basics of this procedure is to loop through a certain number of companies and fill the array with certain properties. That seems easy enough. But it gets slightly more complicated if there are not enough companies before or after my focus company. For instance, if I have eight companies in my class and my focus company is number seven on the list, then I will only have one company that comes after the focus company.

To account for that, I set lStart and lEnd to determine how far I should go. The first step is to find out where my focus company is. The Index property returns my focus company’s position in the order.

Public Property Get Index() As Long
    Dim i As Long
    For i = 1 To Me.Parent.Count
        If Me.Parent.Company(i).CompanyID = Me.CompanyID Then
            Index = i
            Exit For
        End If
    Next i
End Property

This simply loops through every company in the Parent (a CCompanies class) until it finds the focus company. Then it returns i, which is the position in the list. The next several lines determine lStart and lEnd. The easy case is when my focus company is in the middle with plenty of companies before and after it. In that case, I loop from -lRange to lRange (in this example, -3 to 3). If lFocus is too close to the start of the list, I set lStart equal to -lFocus + 1 (the first company in the class). If lFocus is too close to the end of the list, I set lEnd to Me.Count-lFocus (the last company in the class). What I’m actually getting in those two situations is where the first and last companies are compared to where lFocus is.

In this example, there are plenty of companies before Monarch but only two after. I will be looping from -3 to 2 (as offset from lFocus).

Next I establish the dimensions of aReturn. The first “row” of the array will be a header, so I create one more row than I need to hold the companies. In this case, -3 to 2 is six companies (0 is my focus company), so my “row” dimension is 1 to (2 – (-3)) + 2 or 1 to 7.

The next few lines put my header information in to the first element of aReturn and set the lCount (the counter I use to determine what row I’m on) to 1 so as to skip the first row where the header is.

Finally, we get to the loop. Remember we’re looping from -3 to 2. I set clsCurr to the company that’s at lFocus + i. For the first pass through the loop, that will get (6 + (-3)) or the third company in the list. The If block in the loop appends an asterisk in front of the company name if it’s the focus company. The rest of the For loop puts certain data (City, State, and Sales) into the proper “column” dimensions of the array.

The last line assigns the array to the property name so that’s it’s returned to the calling procedure.

Back in the controlling procedure, I want to start my output in cell G1. I resize that array for the number of dimensions in the array. If the array has 6×4 dimensions, then my range is resized to six rows and four columns. Assigning vaOutput to the Value property writes the whole array to the Range at once.

The result shows the three companies whose sales are less than Monarch’s and the two (because there are only two) companies whose sales are greater.

To recap, here are the steps we took to get this list: First, we filled a collection class with all the companies. Next, we found our focus company with a property of the collection class that returns a company given a name or partial name. Then we created a new collection class with only those companies with the same state. We sorted that class on the Sales property. Next, we created an array with the companies a certain number away (both before and after) our focus company. Finally, we assigned that array to the Value property of a Range to write it to the worksheet.

You can download SortFilterClass.zip

Posted in Uncategorized

One thought on “Output from Class to Range

  1. Writing an array to a range in one ‘hit’ is such a common tasks that most Excel developers have a utility function lying around…

    Public Sub ArrayToRange(rngTarget As Excel.Range, InputArray As Variant)
    ‘ Write an array to an Excel range in a single ‘hit’ to the sheet
    ‘ InputArray must be a 2-Dimensional structure of the form Variant(Rows, Columns)

    ‘ The target range is resized automatically to the dimensions of the array, with
    ‘ the top left cell used as the start point.

    ‘ This subroutine saves repetitive coding for a common VBA and Excel task.

    Dim rngOutput As Excel.Range

    Dim iRowCount As Long
    Dim iColCount As Long
    Dim iRow As Integer
    Dim arrTemp As Variant
    Dim iDimensions As Integer

    Dim PriorSetting_EnableEvents As Boolean

    PriorSetting_EnableEvents = Application.EnableEvents
    Application.EnableEvents = False

    If rngTarget.Cells.Count > 1 Then
    End If

    iDimensions = ArrayDimensions(InputArray)

    If iDimensions < 1 Then
        rngTarget.Value = CStr(InputArray)

    ElseIf iDimensions = 1 Then

        iRowCount = UBound(InputArray) – LBound(InputArray)
        iColCount = 1
        ‘ It’s a vector. Yes, I asked for a 2-Dimensional array. But I’m feeling generous.
       ‘ By convention, a vector is presented in Excel as an arry of 1 to n rows and 1 column.
       ReDim arrTemp(LBound(InputArray, 1) To UBound(InputArray, 1), 1 To 1)
        For iRow = LBound(InputArray, 1) To UBound(InputArray, 1)
            arrTemp(iRow, 1) = InputArray(iRow)

        With rngTarget.Worksheet
            Set rngOutput = .Range(rngTarget.Cells(1, 1), rngTarget.Cells(iRowCount + 1, iColCount))
            rngOutput.Value2 = arrTemp
            Set rngTarget = rngOutput
        End With
        Erase arrTemp
    ElseIf iDimensions = 2 Then

        iRowCount = UBound(InputArray, 1) – LBound(InputArray, 1)
        iColCount = UBound(InputArray, 2) – LBound(InputArray, 2)
        With rngTarget.Worksheet
            Set rngOutput = .Range(rngTarget.Cells(1, 1), rngTarget.Cells(iRowCount + 1, iColCount + 1))
            rngOutput.Value = InputArray
            Set rngTarget = rngOutput
        End With

    End If


        Application.EnableEvents = PriorSetting_EnableEvents

    End Sub

    The difficult part is ascertaining the dimensions of the array – is it the expected 2-dimensional array, a vector, or have we received a scalar (a conventional string or numeric variant)?

    You can try to do this by querying:
    Ubound(myVariant, 2) Ubound(myVariant) InStr(Typename(myVariant), “(“)
    …But you need to use On Error Resume Next and a lot of coding. I prefer to use the ArrayDimensions() function published by RB Smissaert:

    Public Function ArrayDimensions(arr As Variant) As Integer
     ‘ will return:
     ‘ -1 if not an array
     ‘ 0  if an un-dimmed array
     ‘ 1  or more indicating the number of dimensions of a dimmed array
      ‘ Originally published by R. B. Smissaert.
     ‘ Additional credits to Bob Phillips, Rick Rothstein, and  Thomas Eyde on VB2TheMax

      Dim ptr As Long
      Dim vType As Integer

      Const VT_BYREF = &H4000&

      ‘get the real VarType of the argument
     ‘this is similar to VarType(), but returns also the VT_BYREF bit
     CopyMemory vType, arr, 2

      ‘exit if not an array
     If (vType And vbArray) = 0 Then
        ArrayDimensions = -1
        Exit Function
      End If

      ‘get the address of the SAFEARRAY descriptor
     ‘this is stored in the second half of the
     ‘Variant parameter that has received the array
     CopyMemory ptr, ByVal VarPtr(arr) + 8, 4

      ‘see whether the routine was passed a Variant
     ‘that contains an array, rather than directly an array
     ‘in the former case ptr already points to the SA structure.
     ‘Thanks to Monte Hansen for this fix
      If (vType And VT_BYREF) Then
        ‘ ptr is a pointer to a pointer
       CopyMemory ptr, ByVal ptr, 4
      End If

      ‘get the address of the SAFEARRAY structure
     ‘this is stored in the descriptor

      ‘get the first word of the SAFEARRAY structure
     ‘which holds the number of dimensions
     ‘…but first check that saAddr is non-zero, otherwise
     ‘this routine bombs when the array is uninitialized

      If ptr Then
        CopyMemory ArrayDimensions, ByVal ptr, 2
      End If

    End Function

    This requires an API function, CopyMemory, declared as shown:

    Private Declare Sub CopyMemory Lib “kernel32” Alias “RtlMoveMemory” _
                        (Destination As Any, _
                         Source As Any, _
                         ByVal Length As Long)

Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.