Finance source

1Attribute VB_Name = "Finance"2Attribute VB_Base = "0{FCFB3D2A-A0FA-1068-A738-08002B3371B5}"3Attribute VB_GlobalNameSpace = False4Attribute VB_Creatable = False5Attribute VB_PredeclaredId = False6Attribute VB_Exposed = False7Attribute VB_TemplateDerived = False8Attribute VB_Customizable = False9Option Explicit1011Enum ExtremumType12    eMin = 013    eMax = 114End Enum1516Function Sum(ByVal vArr As Variant) As Double17    'Returns the sum of numeric values in a column vector1819    Dim lRow                    As Long20    Dim lCol                    As Long21    Dim vValue                  As Variant22    Dim dblSum                  As Double2324    If Not IsArray(vArr) Then Exit Function25    If Arr.DimCounter(vArr) = 1 Then vArr = Arr.DimExpand(vArr)26    If Arr.DimCounter(vArr) <> 2 Then Exit Function2728    lCol = LBound(vArr, 2)2930    For lRow = LBound(vArr, 1) To UBound(vArr, 1)31        vValue = vArr(lRow, lCol)32        If Not IsError(vValue) Then33            If Not IsNull(vValue) Then34                If Not IsEmpty(vValue) Then35                    If IsNumeric(vValue) Then dblSum = dblSum + CDbl(vValue)36                End If37            End If38        End If39    Next lRow4041    Sum = dblSum42End Function4344Function SquaredSum(ByVal vArr As Variant) As Double45    'Returns the sum of squared numeric values in a column vector4647    Dim lRow                    As Long48    Dim lCol                    As Long49    Dim vValue                  As Variant50    Dim dblValue                As Double51    Dim dblSum                  As Double5253    If Not IsArray(vArr) Then Exit Function54    If Arr.DimCounter(vArr) = 1 Then vArr = Arr.DimExpand(vArr)55    If Arr.DimCounter(vArr) <> 2 Then Exit Function5657    lCol = LBound(vArr, 2)5859    For lRow = LBound(vArr, 1) To UBound(vArr, 1)60        vValue = vArr(lRow, lCol)61        If Not IsError(vValue) Then62            If Not IsNull(vValue) Then63                If Not IsEmpty(vValue) Then64                    If IsNumeric(vValue) Then65                        dblValue = CDbl(vValue)66                        dblSum = dblSum + dblValue * dblValue67                    End If68                End If69            End If70        End If71    Next lRow7273    SquaredSum = dblSum74End Function7576Function Count(ByVal vArr As Variant, Optional ByVal bNumeric As Boolean = False) As Long77    'Counts non-empty values, or only numeric values when bNumeric is True7879    Dim lRow                    As Long80    Dim lCol                    As Long81    Dim vValue                  As Variant82    Dim n                       As Long8384    If Not IsArray(vArr) Then Exit Function85    If Arr.DimCounter(vArr) = 1 Then vArr = Arr.DimExpand(vArr)86    If Arr.DimCounter(vArr) <> 2 Then Exit Function8788    lCol = LBound(vArr, 2)8990    For lRow = LBound(vArr, 1) To UBound(vArr, 1)91        vValue = vArr(lRow, lCol)92        If Not IsError(vValue) Then93            If Not IsNull(vValue) Then94                If Not IsEmpty(vValue) Then95                    If Len(CStr(vValue)) > 0 Then96                        If bNumeric Then97                            If IsNumeric(vValue) Then n = n + 198                        Else99                            n = n + 1100                        End If101                    End If102                End If103            End If104        End If105    Next lRow106107    Count = n108End Function109110Function Mean(ByVal vArr As Variant) As Double111    'Returns the mean of numeric values in a column vector112113    Dim n                       As Long114115    If Not IsArray(vArr) Then Exit Function116    If Arr.DimCounter(vArr) = 1 Then vArr = Arr.DimExpand(vArr)117    If Arr.DimCounter(vArr) <> 2 Then Exit Function118119    n = Me.Count(vArr, True)120    If n = 0 Then Exit Function121122    Mean = Me.Sum(vArr) / n123End Function124125Function StDev(ByVal vArr As Variant) As Double126    'Returnds stdof a variant127128    Dim lRow                    As Long129    Dim lCol                    As Long130    Dim n                       As Long131    Dim vValue                  As Variant132    Dim dblMean                 As Double133    Dim dblValue                As Double134    Dim dblDelta                As Double135    Dim dblM2                   As Double136137    If Not IsArray(vArr) Then Exit Function138    If Arr.DimCounter(vArr) = 1 Then vArr = Arr.DimExpand(vArr)139    If Arr.DimCounter(vArr) <> 2 Then Exit Function140141    lCol = LBound(vArr, 2)142143    For lRow = LBound(vArr, 1) To UBound(vArr, 1)144        vValue = vArr(lRow, lCol)145        If Not IsError(vValue) Then146            If Not IsNull(vValue) Then147                If Not IsEmpty(vValue) Then148                    If IsNumeric(vValue) Then149                        'welford algoritlhm150                        dblValue = CDbl(vValue)151                        n = n + 1152                        dblDelta = dblValue - dblMean153                        dblMean = dblMean + dblDelta / n154                        dblM2 = dblM2 + dblDelta * (dblValue - dblMean)155                    End If156                End If157            End If158        End If159    Next lRow160161    If n = 0 Then Exit Function162    If dblM2 < 0 Then dblM2 = 0163164    StDev = Sqr(dblM2 / n)165End Function166167Function Extremum(ByVal vArr As Variant, ByVal eExtremum As ExtremumType) As Double168    'Returns the minimum or maximum numeric value in a column vector169    'eMax = Max170    'eMin = Min171    172    Dim lRow                    As Long173    Dim lCol                    As Long174    Dim vValue                  As Variant175    Dim dblExtremum             As Double176    Dim dblValue                As Double177    Dim bFound                  As Boolean178179    If Not IsArray(vArr) Then Exit Function180    If Arr.DimCounter(vArr) = 1 Then vArr = Arr.DimExpand(vArr)181    If Arr.DimCounter(vArr) <> 2 Then Exit Function182    If eExtremum <> eMin And eExtremum <> eMax Then Exit Function183184    lCol = LBound(vArr, 2)185186    For lRow = LBound(vArr, 1) To UBound(vArr, 1)187        vValue = vArr(lRow, lCol)188        If Not IsError(vValue) Then189            If Not IsNull(vValue) Then190                If Not IsEmpty(vValue) Then191                    If IsNumeric(vValue) Then192                        dblValue = CDbl(vValue)193                        If Not bFound Then194                            dblExtremum = dblValue195                            bFound = True196                        ElseIf eExtremum = eMax Then197                            If dblValue > dblExtremum Then dblExtremum = dblValue198                        Else199                            If dblValue < dblExtremum Then dblExtremum = dblValue200                        End If201                    End If202                End If203            End If204        End If205    Next lRow206207    If bFound Then Extremum = dblExtremum208End Function209210211