xlf QandA series

develop a VBA version of the ATP covariance dialog box - step 1


QUESTION

OUR TEAM IS TRYING TO DEVELOP A VBA VERSION OF THE ATP COVARIANCE DIALOG BOX. WHERE DO WE START?


Answer icon Answer

The analysis toolpak (ATP) add-in - covariance dialog box - is shown in figure 1. It has two basic areas, an Input frame object in the upper half, and an Output options frame object in the lower half. The dialog box is an interface to the covariance engine.


Input has three basic components

  1. Input range
  2. Rows / columns
  3. Header labels

Output has several variations of a target range

The OK button triggers the calculation

xlf-atp-covariance
Fig 1: ATP covariance dialog box - a model for development in the UserForm environment

The ATPCovar macro

The for the ATP covariance ATPCovar procedure - see code 1. VBA comments are included.



Code 1: The ATPCovar macro: Input from a range object, return covariance to target range 
Option Explicit
'' Interface link
Dim Labels As Boolean
Dim Columns As Boolean
Dim InRange As String
Dim OutRange As String

Sub ATPCovar()

Dim strHeader() As String, dblData() As Double, dblCovar() As Double
Dim NoRows As Long, NoCols As Long
Dim xlData As Variant
Dim InRange1 As String, InRange2 As String, InRange3 As String
Dim i As Long, j As Long, iMin As Integer, iMax As Long

'' Interface link - temporary
Labels = True: Columns = True
InRange1 = "$B$2:$E$14"  '' Columns and labels
InRange2 = "$G$2:$S$5"   '' Rows and labels
InRange3 = "$B$3:$E$14"  '' Columns - no header row / labels
OutRange = "$M$10"

    If Columns And Labels Then
        xlData = Range(InRange1)
    ElseIf Columns = True And Labels = False Then
        xlData = Range(InRange3)
    Else
        xlData = Application.Transpose(Range(InRange2))
    End If

    NoRows = UBound(xlData, 1): NoCols = UBound(xlData, 2)
    
'' === Setup the header row ===
    ReDim strHeader(1 To NoCols)
    For i = 1 To NoCols
        If Labels = True Then
            iMin = 2: iMax = NoRows
            strHeader(i) = Application.Index(xlData, 1, i)
        Else
            iMin = 1: iMax = NoRows
            strHeader(i) = "Series" & i
        End If
    Next i

'' === Setup the data ===
    ReDim dblData(iMin To iMax, 1 To NoCols)
    i = 0: j = 0
    For i = iMin To iMax
        For j = 1 To NoCols
            dblData(i, j) = xlData(i, j)
        Next j
    Next i
    
'' === Calculate and store the covariance matrix ===
    ReDim dblCovar(1 To NoCols, 1 To NoCols)
    i = 0: j = 0
    With Application
        For i = 1 To NoCols
            For j = 1 To NoCols
                dblCovar(i, j) = .Covariance_S(.Index(dblData, 0, i), .Index(dblData, 0, j))
            Next j
        Next i
    End With
    
'' === Send VCV to Excel range ===
    Range(OutRange).Resize(1, 1).Select
        For i = 1 To NoCols
            For j = 1 To NoCols
                Selection.Offset(0, i) = strHeader(i)
                Selection.Offset(i, 0) = strHeader(i)
                Selection.Offset(i, j) = dblCovar(i, j)
            Next j
        Next i

End Sub

Test data

Fig 2: Excel Web App #1 - stock returns - four companies - and ATP covariance value

Stock return data, column orientation (blue), and row orientation (green) - figure 2. The ATP covariance values are in the range G10:K14. Download the file with the Excel Web App #1 Download button.