Access Maximum Function: Return the second highest value across 10 fields

Question

I have no experience writing VBA code but I can follow the logic.

Thank you for everyone's help in advance!

I found a VBA code that calculates the second highest value across a series of 10 fields (temp array and TWO sorts). It actually works great except if the first field is a zero or all fields contain zero.

Function Maximum (ParamArray FieldArray() As Variant)
' Declare the two local variables.
Dim I As Integer
Dim currentVal As Variant
Dim secondHighest As Variant

' Set the variable currentVal equal to the array of values.
  currentVal = FieldArray (0)

' Cycle through each value from the row to find the largest.

    Dim tmpArray
    For I = 0 To UBound(FieldArray)
        If FieldArray(I) > currentVal Then
        currentVal = FieldArray(I)
        End If
    Next

tmpArray = Filter (FieldArray, currentVal, False, vbTextCompare)
'This will fill the tmpArray with all your array values EXCEPT the highest one.

    secondHighest = tmpArray(0)
        For I = 0 To UBound(tmpArray)
        If tmpArray(I) > secondHighest Then
        secondHighest = tmpArray(I)
    End If
    Next

' Return the maximum value found.
Maximum = secondHighest

' Expr1: Maximum ([nPP1CSF],[nPP2CSF],[nPP3CSF],[nPP4CSF],[nPP5CSF],[nPP6CSF],[nPP7CSF],[nPP8CSF],[nPP9CSF],[nPP0CSF])

End Function

Thank you for your prompt response! I now have the error "type mismatch". It occurs at line "If Not (Not tmpArray) Then"

Thank you for your prompt response! I now have the error "type mismatch". It occurs at line "If Not (Not tmpArray) Then" — liamthequietman, Feb 23 '18 at 16:55

score 0 · Answer 1 · answered Feb 23 '18 at 16:37

Your tmpArray can contain 0 items. You should check for that.

That's easier said than done, I use this trick for testing

(Theoretically, your FieldArray can contain 0 items too if someone doesn't use it properly).

Function Maximum (ParamArray FieldArray() As Variant)
' Declare the two local variables.
Dim I As Integer
Dim currentVal As Variant
Dim secondHighest As Variant
If (Not FieldArray) = -1 Then Exit Function 'If nothing gets entered, do nothing
' Set the variable currentVal equal to the array of values.
  currentVal = FieldArray (0)

' Cycle through each value from the row to find the largest.

    Dim tmpArray
    For I = 0 To UBound(FieldArray)
        If FieldArray(I) > currentVal Then
        currentVal = FieldArray(I)
        End If
    Next

tmpArray = Filter (FieldArray, currentVal, False, vbTextCompare)
'This will fill the tmpArray with all your array values EXCEPT the highest one.
If Not (Not tmpArray) Then
    secondHighest = tmpArray(0)
        For I = 0 To UBound(tmpArray)
        If tmpArray(I) > secondHighest Then
        secondHighest = tmpArray(I)
    End If
    Next
End If
' Return the maximum value found.
Maximum = secondHighest

' Expr1: Maximum ([nPP1CSF],[nPP2CSF],[nPP3CSF],[nPP4CSF],[nPP5CSF],[nPP6CSF],[nPP7CSF],[nPP8CSF],[nPP9CSF],[nPP0CSF])

End Function

Access Maximum Function: Return the second highest value across 10 fields

1 Answers1