Attribute VB_Name = "modme"
'Function takes an array with numeric elements as a parameter
'and calcuates the standard deviation

Public Sub ColorListviewRow(lv As ListView, RowNbr As Long, RowColor As OLE_COLOR)
'***************************************************************************
'Purpose: Color a ListView Row
'Inputs : lv - The ListView
'         RowNbr - The index of the row to be colored
'         RowColor - The color to color it
'Outputs: None
'***************************************************************************
    
    Dim itmX As ListItem
    Dim lvSI As ListSubItem
    Dim intIndex As Integer
    
    On Error GoTo ErrorRoutine
    
    Set itmX = lv.ListItems(RowNbr)
    itmX.ForeColor = RowColor
    For intIndex = 1 To lv.ColumnHeaders.count - 1
        Set lvSI = itmX.ListSubItems(intIndex)
        lvSI.ForeColor = RowColor
    Next

    Set itmX = Nothing
    Set lvSI = Nothing
    
    Exit Sub

ErrorRoutine:

    MsgBox Err.Description

End Sub
Function mymedian()

End Function

Public Function StandardDeviation(NumericArray As Variant) _
As Double

Dim dblSum As Double, dblSumSqdDevs As Double, dblMean As Double
Dim lngCount As Long, dblAnswer As Double
Dim vElement As Variant
Dim lngStartPoint As Long, lngEndPoint As Long, lngCtr As Long

On Error GoTo ErrorHandler
'if NumericArray is not an array, this statement will
'raise an error in the errorhandler

lngCount = UBound(NumericArray)

On Error Resume Next
lngCount = 0

'the check below will allow
'for 0 or 1 based arrays.

vElement = NumericArray(0)

lngStartPoint = IIf(Err.Number = 0, 0, 1)
lngEndPoint = UBound(NumericArray)

'get sum and sample size
For lngCtr = lngStartPoint To lngEndPoint
  vElement = NumericArray(lngCtr)
    If IsNumeric(vElement) Then
      lngCount = lngCount + 1
      dblSum = dblSum + CDbl(vElement)
    End If
Next

'get mean
If lngCount > 1 Then
    dblMean = dblSum / lngCount

    'get sum of squared deviations
    For lngCtr = lngStartPoint To lngEndPoint
        vElement = NumericArray(lngCtr)

        If IsNumeric(vElement) Then
            dblSumSqdDevs = dblSumSqdDevs + _
            ((vElement - dblMean) ^ 2)
        End If
    Next

'divide result by sample size - 1 and get square root.
'this function calculates standard deviation of a sample.
'If your  set of values represents the population, use sample
'size not sample size - 1

    If lngCount > 1 Then
        lngCount = lngCount - 1 'eliminate for population values
        dblAnswer = Sqr(dblSumSqdDevs / lngCount)
    End If
    
End If

StandardDeviation = dblAnswer

Exit Function

ErrorHandler:
Err.Raise Err.Number
Exit Function
End Function
Public Function Median(ByVal NumericArray As Variant, num As Integer) _
   As Double
'******************************************************'
'INPUT:   An Array of Numbers
'RETURNS: The statistical median of that array.
'         If invalid data is passed, i.e., a value that
'         is not an array, or the Array contains non-numeric
'         data, an error is raised
'EXAMPLE:
'        Dim vNumbers as Variant
'        dim dblMedian as double
'        vNumbers = array(4, 9, 1, 5, 3, 1, 7)
'        dblMedian = Median(vNumbers)
'****************************************************
Dim arrLngAns As Variant
Dim lngElement1 As Long
Dim lngElement2 As Long
Dim dblSum As Double
Dim dblAns As Double


Dim lngElementCount As Long
'sort array
arrLngAns = BubbleSortArray(NumericArray)
If Not IsArray(arrLngAns) Then
    Err.Raise 30000, , "Invalid Data Passed to function"
    Exit Function
End If
lngElementCount = (UBound(arrLngAns) - LBound(arrLngAns)) + 1
lngElementCount = lngElementCount - num

    If UBound(arrLngAns) Mod 2 = 0 Then
        lngElement1 = (UBound(arrLngAns) / 2) + (LBound(arrLngAns) / 2)
    Else
        lngElement1 = Int(UBound(arrLngAns) / 2) + Int(LBound(arrLngAns) / 2) + 1
    End If
    
    If lngElementCount Mod 2 <> 0 Then
    If (arrLngAns(lngElement1)) = "" Then
    dblAns = -1
    Else
        dblAns = arrLngAns(lngElement1)
        End If
        
    Else
        lngElement2 = lngElement1 + 1
        If (arrLngAns(lngElement1)) = "" Then
    dblAns = -1
    Else
        dblSum = arrLngAns(lngElement1) + arrLngAns(lngElement2)
        dblAns = dblSum / 2
        End If
        
    End If

Median = dblAns
End Function

Public Function Median2(X() As Variant, n As Integer)
'this function calculates the median of a vector
 
'Determine Median
    If n Mod 2 = 0 Then
        Median2 = 0.5 * (X(n / 2) + X((n + 2) / 2))
    Else
        Median2 = X((n + 1) / 2)
    End If

End Function

Function CountByItem(anItem As Variant, aReset As Integer) As Long
    'Return next counter for the same anItem
    '     value
    'The counter is reset to 1 when anItem &
    '     lt;> lastItem
    'If forceReset = 0 then counter is force
    '     d to 0 and 0 is returned
    Static countValue As Long
    Static lastItem As Variant

    If aReset = 0 Then
        countValue = 0
        CountByItem = 0
        Exit Function
    End If


    If anItem <> lastItem Then
        countValue = 1
        lastItem = anItem
    Else
        countValue = countValue + 1
    End If

    CountByItem = countValue
End Function
'===============================================================
Public Sub ShellSort(X() As Variant, n As Integer)
'This subroutine performs the Shell sort of a vector

'Define variables
    Dim gap As Integer
    Dim doneFlag As Boolean
    Dim index As Integer
    Dim temp As Single
    
'Perform sort
    gap = Int(n / 2)
    Do While gap >= 1
        Do
            doneFlag = True
            For index = 1 To n - gap
                If X(index) > X(index + gap) Then
                    temp = X(index)
                    X(index) = X(index + gap)
                    X(index + gap) = temp
                    doneFlag = False
                End If
            Next index
        Loop Until doneFlag = True
        gap = Int(gap / 2)
    Loop
    
End Sub


Public Function BubbleSortArray(ByVal NumericArray As Variant) _
    As Variant
'http://www.freevbcode.com/ShowCode.Asp?ID=580


Dim vAns As Variant
Dim vTemp As Variant
Dim bSorted As Boolean
Dim lCtr As Long
Dim lCount As Long
Dim lStart As Long


vAns = NumericArray
  
If Not IsArray(vAns) Then
    BubbleSortArray = vbEmpty
    Exit Function
End If

'On Error GoTo ErrorHandler

lStart = LBound(vAns)
lCount = UBound(vAns)

    bSorted = False
   
    Do While Not bSorted
      bSorted = True

      For lCtr = lCount - 1 To lStart Step -1
        If vAns(lCtr + 1) < vAns(lCtr) Then
          DoEvents
          bSorted = False
           vTemp = vAns(lCtr)
           vAns(lCtr) = vAns(lCtr + 1)
           vAns(lCtr + 1) = vTemp
         End If
      Next lCtr
      
    Loop
    
BubbleSortArray = vAns
Exit Function

ErrorHandler:
BubbleSortArray = vbEmpty

Exit Function
End Function