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

[liamthequietman]

The code works great except if the first field is a zero or all the fields in the row contain zeros (see pic).

Many thanks!

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

[IMGNOTHUMB]https://bytes.com/attachments/attachment/9380d1520099099/zmax-second.jpg[/IMGNOTHUMB]

[gnawoncents]

Liam,
Welcome to Bytes! There are a couple issues keeping you from the answer you want. First, anytime all the numbers are the same (not just zeroes), the code won't be able to handle it because you're filtering out all the variables. You can solve this by counting how many times the numbers are the same--if they are always the same, just force insert what you want into the field (since there is no second-highest number, I'm not sure what this would be). Also, you'll run into some interesting problems if you leave the values as variables. I changed them to integers in the code below.

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

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

' Cycle through each value from the row to find the largest.
For I = 0 To UBound(FieldArray)
    If FieldArray(I) > currentVal Then
        currentVal = FieldArray(I)
      ElseIf FieldArray(I) = currentVal Then
        intCount = intCount + 1
    End If
Next

If intCount - 1 = UBound(FieldArray) Then
    ' Return the starting value since they were all the same
    Maximum = FieldArray(0) 'MODIFY THIS TO WHATEVER YOU WANT WHEN THEY ARE ALL THE SAME
  Else
    Dim tmpArray As Variant
    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
End If

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

End Function

[twinnyfo]

liamthequietman ,

If you will indulge me the opportunity to modify gnawoncents's excellent suggestion....

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

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

    ' Cycle through each value from the row to find the largest.
    For I = 0 To UBound(FieldArray)
        If FieldArray(I) = currentVal Then intCount = intCount + 1
        If FieldArray(I) > currentVal Then
            secondHighest = currentVal
            currentVal = FieldArray(I)
        Else
            If FieldArray(I) > secondHighest _
                And FieldArray(I) < currentVal Then
                secondHighest = FieldArray(I)
            End If
        End If
    Next

    If intCount - 1 = UBound(FieldArray) Then
        ' Return the starting value since they were all the same
        Maximum = FieldArray(0) 'MODIFY THIS TO WHATEVER YOU WANT WHEN THEY ARE ALL THE SAME
    Else
        ' Return the maximum value found.
        Maximum = secondHighest
    End If

    Exit Function
EH:
    MsgBox "There was an error finding the second highest value!  " & _
        "Please contact your Database Administrator.", vbCritical, "WARNING!"
    Exit Function
End Function

If you look closely above, I've eliminated the need to go through your array twice. Assuming your beginning highest value is in currentVal (which will begin at 0), then if there is any value greater than that, the higher value becomes currentVal. But, before we do that, we asign the value of currentVal to secondHighest (which initially will also be 0). Then if any future values are greater than currentVal, then secondHighest takes on the value of the previous highest value. There is an Else added to the code to handle cases in which the new value is less than currentVal but greater than secondHighest.

This should give you a more streamlined code (and faster, at that).

Hope this hepps!

[gnawoncents]

twinnyfo,

Very nice--much more elegant. *initiates slow clap*

[twinnyfo]

gnawoncents,

Aww shucks.... I just stole what you posted!

:-P

[liamthequietman]

BRILLIANT!

What an excellent collaboration between the two of you!

I hope others can benefit from this excellent code.

I'm very grateful!

[twinnyfo]

Glad the two of us could hepp!

[liamthequietman]

I've made changes to the code for "Minimum" values "Second Lowest" The values are Single and contain -1

It works perfect except if a -1 appears in any of the columns.

Greatly appreciated!

(see pic)

Function Minimum(ParamArray FieldArray() As Variant)
    On Error GoTo EH
        ' Declare the two local variables.
        Dim I As Integer
        Dim currentVal As Single
        Dim secondLowest As Single
        Dim intCount As Integer
     
        ' Set the variable currentVal equal to the array of values.
        currentVal = FieldArray(0)
     
        ' Cycle through each value from the row to find the lowest.
        For I = 0 To UBound(FieldArray)
            If FieldArray(I) = currentVal Then intCount = intCount + 1
            If FieldArray(I) < currentVal Then
                secondLowest = currentVal
                currentVal = FieldArray(I)
            Else
                If FieldArray(I) < secondLowest _
                    And FieldArray(I) > currentVal Then
                    secondLowest = FieldArray(I)
                End If
            End If
        Next
     
        If intCount - 1 = UBound(FieldArray) Then
            ' Return the starting value since they were all the same
            Minimum = FieldArray(0) 'Modify this to whatever you want when they are all the same
        Else
            ' Return the Minimum value found.
            Minimum = secondLowest
        End If
     
        Exit Function
EH:
        MsgBox "There was an error finding the second Lowest value!  " & _
            "Please contact your Database Administrator.", vbCritical, "WARNING!"
        Exit Function
        
' Expr1: Minimum([nPP1SHF],[nPP2SHF],[nPP3SHF],[nPP4SHF],[nPP5SHF],[nPP6SHF],[nPP7SHF],[nPP8SHF],[nPP9SHF],[nPP0SHF])

End Function

[twinnyfo]

All you need to do is reverse you ">" and "<" operators.

[liamthequietman]

I edited my post. Please read again I almost have the solution!

Thanks!

[twinnyfo]

liam - for future posts, please use Code Tags when posting your code. The moderators are able to edit your content, but we shouldn't have to do that every time.

[twinnyfo]

What happens when there is a -1 in any of the values. It should work with positive or negative numbers.

[liamthequietman]

I'm a novice and will now Google "Code Tags" to understand what they are.

My apologies!

[liamthequietman]

My changes to the code work perfect except if a -1 appears in any column.

see pic in post I edited

[twinnyfo]

Code tags are what you place your code in so that they are properly formatted on this forum. There is a button in the text entry display "[CODE/] which will insert code tags around any of your selected text.

Your pic does not tell me what the code is doing wrong. It looks to me to be doing exactly what the code is telling it to do. What do you want the result to be when it is all -1? Are these by chance text values?