VB and VBA Users Source Code: Functions for calculating the Min, Max and StdDev
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Functions for calculating the Min, Max and StdDev
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Wednesday, August 08, 2001
Hits:
911
Category:
Visual Basic General
Article:
The following functions can be used to calculate the minimum, maximum and standard deviation of a list of arguments. Option Explicit 'Purpose : Returns the Minimum value from a parameter Array 'Inputs : avValues() as Variant 'Outputs : The Min Value contained within the input (excluding empty values) 'Author : Andrew Baker 'Date : 30/05/2000 00:00 'Notes : Examples: ' Min(1,2,empty,-1) Returns -1 ' Min(Array(1,2,-1),-4,-9.9) Returns -9.9 ' Min(1/Jan/99,2/Jan/99) Returns 1/Jan/99 'Revisions : Function Min(ParamArray avValues() As Variant) As Variant Dim vThisItem As Variant, vThisElement As Variant On Error Resume Next For Each vThisItem In avValues If IsArray(vThisItem) Then For Each vThisElement In vThisItem Min = Min(vThisElement, Min) Next Else If vThisItem < Min Then If Not IsEmpty(vThisItem) Then Min = vThisItem End If ElseIf IsEmpty(Min) Then Min = vThisItem End If End If Next On Error GoTo 0 End Function 'Purpose : Returns the Maximum value from a parameter Array 'Inputs : avValues() as Variant 'Outputs : The Max Value contained within the input (excluding empty values) 'Author : Andrew Baker 'Date : 30/05/2000 00:00 'Notes : Examples: ' Max(1,2,empty,-1) Returns 2 ' Max(Array(1,2,-1),-4,-9.9) Returns 2 ' Max(1/Jan/99,2/Jan/99) Returns 2/Jan/99 'Revisions : Function Max(ParamArray avValues() As Variant) As Variant Dim vThisItem As Variant, vThisElement As Variant On Error Resume Next For Each vThisItem In avValues If IsArray(vThisItem) Then For Each vThisElement In vThisItem Max = Max(vThisElement, Max) Next Else If vThisItem > Max Then If Not IsEmpty(vThisItem) Then Max = vThisItem End If ElseIf IsEmpty(Max) Then Max = vThisItem End If End If Next On Error GoTo 0 End Function 'Purpose : Returns the Average of many things, they could be dates or numbers. 'Inputs : avValues A 1D Array of Values to evaluate 'Outputs : The average value of the input parameters 'Author : Andrew Baker 'Date : 02/07/2000 01:48 'Notes : 'Revisions : Function Average(ParamArray avValues() As Variant) As Variant Dim vTotal As Variant, lThisItem As Variant, vThisElement As Variant, lItems As Long For Each lThisItem In avValues If IsArray(lThisItem) Then For Each vThisElement In lThisItem If Not IsEmpty(vThisElement) And IsNumeric(vThisElement) Then vTotal = vTotal + vThisElement lItems = lItems + 1 End If Next ElseIf Not IsEmpty(lThisItem) And IsNumeric(lThisItem) Then vTotal = vTotal + lThisItem lItems = lItems + 1 End If Next If lItems Then Average = vTotal / lItems End If End Function 'Purpose : Calculate the Standard Devation of a population 'Inputs : avValues. A 1D Array of Values. ' [avWeights]. A 1D Array of weights. If supplied the function ' will calculated a weighted standard deviation. 'Outputs : The Standard Deviation or N/A if less than three values 'Author : Andrew Baker 'Date : 02/07/2000 01:48 'Notes : 'Revisions : Function StdDevP(avValues As Variant, Optional avWeights) As Variant Dim dThisWeight As Double, lThisItem As Long Dim dValue1 As Double, dValue2 As Double, dSumWeights As Double On Error GoTo ErrFailed If UBound(avValues) - LBound(avValues) >= 3 Then 'Have more than three values dThisWeight = 1 For lThisItem = LBound(avValues) To UBound(avValues) If IsArray(avWeights) Then dThisWeight = avWeights(lThisItem) End If dValue1 = dValue1 + (dThisWeight * avValues(lThisItem) * avValues(lThisItem)) dSumWeights = dSumWeights + dThisWeight dValue2 = dValue2 + (dThisWeight * avValues(lThisItem)) Next dValue1 = dValue1 / dSumWeights dValue2 = (dValue2 / dSumWeights) ^ 2 'Abs prevents a run time if round errors occur 'which make the number negative StdDevP = Abs(dValue1 - dValue2) ^ 0.5 Else 'Require three values StdDevP = "N/A" End If Exit Function ErrFailed: Debug.Print "Error in StdDevP: " & Err.Description StdDevP = "N/A" End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
