Public Function getSTDev(ParamArray varVals() As Variant) As Variant
Dim varVal As Variant
Dim intcount As Integer
Dim Arr() As Variant
For Each varVal In varVals
If IsNumeric(varVal) Then
Arr = AddElement(Arr, varVal)
End If
Next varVal
getSTDev = StdDev(Arr)
End Function
Function StdDev(Arr() As Variant) As Variant
Dim i As Integer
Dim avg As Single, SumSq As Single
Dim k As Integer
If Not HasDimension(Arr) Then Exit Function
If Not UBound(Arr) = LBound(Arr) Then
avg = Mean(Arr)
For i = LBound(Arr) To UBound(Arr)
SumSq = SumSq + (Arr(i) - avg) ^ 2
k = k + 1
Next i
If k > 1 Then
StdDev = Sqr(SumSq / (k - 1))
End If
End If
End Function
Public Function AddElement(ByVal vArray As Variant, ByVal vElem As Variant) As Variant
' This function adds an element to a Variant array
' and returns an array with the element added to it.
Dim vRet As Variant ' To be returned
If IsEmpty(vArray) Or Not IsDimensioned(vArray) Then
' First time through, create an array of size 1.
vRet = Array(vElem)
Else
vRet = vArray
' From then on, ReDim Preserve will work.
ReDim Preserve vRet(UBound(vArray) + 1)
vRet(UBound(vRet)) = vElem
End If
AddElement = vRet
End Function
Public Function IsDimensioned(ByRef TheArray) As Boolean
If IsArray(TheArray) Then ' we need to test it! otherwise will return false if not an array!
' If you put extensive use to this function then you might modify
' it a lil' bit so it "takes in" specific array type & you can skip IsArray
' (currently you can pass any variable).
On Error Resume Next
IsDimensioned = ((UBound(TheArray) - LBound(TheArray)) >= 0)
On Error GoTo 0
Else
'IsDimensioned = False ' is already false by default
Call Err.Raise(5, "IsDimensioned", "Invalid procedure call or argument. Argument is not an array!")
End If
End Function
Public Function HasDimension(ByRef TheArray, Optional ByRef Dimension As Long = 1) As Boolean
Dim isDim As Boolean
Dim ErrNumb As Long
Dim LB As Long
Dim errDesc As String
'HasDimension = False
If (Dimension > 60) Or (Dimension < 1) Then
Call Err.Raise(9, "HasDimension", "Subscript out of range. ""Dimension"" parameter is not in its legal borders (1 to 60)! Passed dimension value is: " & Dimension)
Exit Function
End If
On Error Resume Next
isDim = IsDimensioned(TheArray) 'IsArray & IsDimensioned in one call. If Err 5 will be generated if not Array
ErrNumb = Err.Number
If ErrNumb <> 0 Then
errDesc = Err.Description
End If
On Error GoTo 0
Select Case ErrNumb
Case 0
If isDim Then
On Error Resume Next
LB = LBound(TheArray, Dimension) 'just try to retrive Lbound
HasDimension = (Err.Number = 0)
On Error GoTo 0
End If
Case 5
Call Err.Raise(5, "HasDimension", "Invalid procedure call or argument. Argument is not an array!")
Case Else
Call Err.Raise(vbObjectError + 1, "HasDimension", _
"This is unexpected error, caused when calling ""IsDimensioned"" function!" & vbCrLf & _
"Original error: " & ErrNumb & vbCrLf & _
"Description:" & errDesc)
End Select
End Function
Function Mean(Arr() As Variant)
Dim Sum As Single
Dim i As Integer
Dim k As Integer
Sum = 0
For i = LBound(Arr) To UBound(Arr)
k = k + 1
Sum = Sum + Arr(i)
Next i
Mean = Sum / k
'MsgBox Mean
End Function
Public Sub testSDEV()
MsgBox getSTDev(Null, 3, 2, Null)
End Sub
