Option Explicit
'https://chat.stackoverflow.com/rooms/167099/discussion-between-qharr-and-i--newb

Public Sub PerformLogOperation()

    Dim wbTarget As Workbook
    Dim wsTarget As Worksheet

    Set wbTarget = ThisWorkbook
    Set wsTarget = wbTarget.Worksheets("HistoricalDataandCalculations")

    Dim namedRange As Range
    Dim namesArr()

    Set namedRange = wsTarget.Range("HDaCReturns")

    namesArr = GetNamedRangeNames(namedRange)

    CreateNamedRanges namedRange, namesArr

    With wsTarget
       .Range(.Cells(namedRange.Row + namedRange.Rows.Count, 1), .Cells(.Rows.Count, .Columns.Count)).ClearContents
    End With

    PopulateFormulas namedRange

    AddMeanSDCalculations namesArr, namedRange, wsTarget

    ConvertFormulasToValues wsTarget

    Dim targetVarMatrixCell As Range

    With namedRange
        Set targetVarMatrixCell = .Offset(.Rows.Count + 1, .Columns.Count + 2).Resize(1, 1) 'the top left corner cell of matrix (will be empty as between headers)
    End With

    AddVarianceCovarianceMatrix targetVarMatrixCell, namesArr, namedRange

End Sub

Public Sub CreateNamedRanges(ByVal namedRange As Range, ByVal namesArr As Variant, Optional wbTarget As Workbook)

    Dim currentNamedRange As Long
    Dim tempRange As Range
    Dim tempRangeName As String

    If wbTarget Is Nothing Then Set wbTarget = ThisWorkbook

    Dim sheetName As String
    Dim startRow As Long
    Dim endRow As Long
    Dim columnForCount

    sheetName = namedRange.Parent.Name
    startRow = namedRange.Row + 2
    endRow = namedRange.Parent.Cells.Rows.Count
    columnForCount = namedRange.Column

    For currentNamedRange = LBound(namesArr, 2) To UBound(namesArr, 2)

        With namedRange
         Set tempRange = .Columns(currentNamedRange + 1).Offset(2, 0).Resize(.Rows.Count - 2, 1)
        End With

        tempRangeName = Trim$(namesArr(1, currentNamedRange))

        wbTarget.Names.Add Name:=tempRangeName, _
                           RefersTo:="=OFFSET(" & sheetName & "!R" & startRow & "C" & columnForCount + currentNamedRange & _
                                      ",0,0,COUNT(" & sheetName & "!R" & startRow & "C" & columnForCount & ":R" & endRow & "C" & _
                                            columnForCount & ")-1,1)"

        Set tempRange = Nothing
        tempRangeName = vbNullString

    Next currentNamedRange

End Sub

Public Function GetNamedRangeNames(ByVal namedRange As Range) As Variant

    Dim namesArr()

    With namedRange.Rows(1)

        namesArr = .Offset(, 1).Resize(1, .Columns.Count - 1).Value2

    End With

    GetNamedRangeNames = namesArr

End Function

Public Sub AddMeanSDCalculations(ByVal namesArr As Variant, ByVal namedRange As Range, ByVal wsTarget As Worksheet)

    Dim currentName As Long

    With namedRange
        .Offset(.Rows.Count + 1, .Columns.Count).Resize(1, 1) = "Average"
        .Offset(.Rows.Count + 3, .Columns.Count).Resize(1, 1) = "StDev_P"
        .Offset(.Rows.Count + 5, .Columns.Count).Resize(1, 1) = "Var_P"
        .Offset(.Rows.Count + 7, .Columns.Count).Resize(1, 1) = "Excess Returns"
        .Offset(.Rows.Count, (.Columns.Count * 3) - 2).Resize(1, 1) = "Mean Returns"
        .Offset(.Rows.Count, 3 * .Columns.Count).Resize(1, 1) = "Portfolio Proportions"
    End With

    For currentName = LBound(namesArr, 2) To UBound(namesArr, 2)

        With namedRange
          .Offset(.Rows.Count + 1, currentName).Resize(1, 1) = Application.WorksheetFunction.Average(wsTarget.Range(namesArr(1, currentName)))
          .Offset(.Rows.Count + 3, currentName).Resize(1, 1) = Application.WorksheetFunction.StDev_P(wsTarget.Range(namesArr(1, currentName)))
          .Offset(.Rows.Count + 5, currentName).Resize(1, 1) = Application.WorksheetFunction.Var_P(wsTarget.Range(namesArr(1, currentName)))
        End With

    Next currentName

    Dim portfolioProportions As Range

    With namedRange
        .Offset(.Rows.Count + 2, (.Columns.Count * 3) - 2).Resize(.Columns.Count - 1, 1) = Application.WorksheetFunction.Transpose(.Offset(.Rows.Count + 1, 1).Resize(1, .Columns.Count - 1))
        Set portfolioProportions = .Offset(.Rows.Count + 2, (.Columns.Count * 3)).Resize(.Columns.Count - 1, 1)
    End With

    portfolioProportions = 0.2

End Sub

Public Sub PopulateFormulas(ByVal namedRange As Range)

    Dim returns As Range
    Dim excessReturns As Range

    With namedRange

       Set returns = .Offset(2, 1).Resize(.Rows.Count - 3, .Columns.Count - 1)
       Set excessReturns = .Offset(.Rows.Count + 7, 1).Resize(.Rows.Count - 3, .Columns.Count - 1)

    End With

    returns.FormulaR1C1 = "=LN(R[-103]C/R[-102]C)"
    excessReturns.FormulaArray = "=R[-106]C:R[-9]C[3]-R[-6]C:R[-6]C[3]" 'TODO Verify fit for purpose if num columns changes

End Sub

Public Sub ConvertFormulasToValues(ByVal wsTarget As Worksheet)

    With wsTarget.UsedRange
        .Value = .Value
    End With

End Sub

Public Sub AddVarianceCovarianceMatrix(ByVal targetVarMatrixCell As Range, ByVal namesArr As Variant, ByVal namedRange As Range)

    Dim columnHeaders As Range
    Dim rowHeaders As Range
    Dim matrixArea As Range
    Dim excessReturns As Range

    Set columnHeaders = targetVarMatrixCell.Offset(, 1).Resize(1, UBound(namesArr, 2))
    Set rowHeaders = targetVarMatrixCell.Offset(1, 0).Resize(UBound(namesArr, 2), 1)
    Set matrixArea = targetVarMatrixCell.Offset(1, 1).Resize(UBound(namesArr, 2), UBound(namesArr, 2))

    With targetVarMatrixCell.Offset(-2, 0)
        .Value = "Variance-Covariance Matrix"
        .HorizontalAlignment = xlLeft
    End With

    With namedRange

        Set excessReturns = .Offset(.Rows.Count + 7, 1).Resize(.Rows.Count - 3, .Columns.Count - 1)

    End With

    columnHeaders = namesArr
    rowHeaders = Application.WorksheetFunction.Transpose(columnHeaders)

    matrixArea.FormulaArray = "=MMULT(TRANSPOSE( " & excessReturns.Address & ")," & excessReturns.Address & ")/ROWS(" & excessReturns.Address & ")"

    ColourMatrix matrixArea

End Sub

Public Sub ColourMatrix(ByVal matrixArea As Range)

    Dim currRow As Long, currColumn As Long

    For currRow = 1 To matrixArea.Rows.Count

        For currColumn = 1 To matrixArea.Columns.Count

            If currRow = currColumn Then

                With matrixArea.Cells(currRow, currColumn).Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent1
                    .TintAndShade = 0.799981688894314
                End With

            End If

        Next currColumn

    Next currRow

End Sub