423,867 Members | 1,958 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 423,867 IT Pros & Developers. It's quick & easy.

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

P: 13
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!

Expand|Select|Wrap|Line Numbers
  1. Function Maximum(ParamArray FieldArray() As Variant)
  2. ' Declare the two local variables.
  3. Dim I As Integer
  4. Dim currentVal As Variant
  5. Dim secondHighest As Variant
  6.  
  7. ' Set the variable currentVal equal to the array of values.
  8.   currentVal = FieldArray(0)
  9.  
  10. ' Cycle through each value from the row to find the largest.
  11.  
  12.     Dim tmpArray
  13.     For I = 0 To UBound(FieldArray)
  14.         If FieldArray(I) > currentVal Then
  15.         currentVal = FieldArray(I)
  16.         End If
  17.     Next
  18.  
  19. tmpArray = Filter(FieldArray, currentVal, False, vbTextCompare)
  20. 'This will fill the tmpArray with all your array values EXCEPT the highest one.
  21.  
  22.     secondHighest = tmpArray(0)
  23.         For I = 0 To UBound(tmpArray)
  24.         If tmpArray(I) > secondHighest Then
  25.         secondHighest = tmpArray(I)
  26.     End If
  27.     Next
  28.  
  29. ' Return the maximum value found.
  30. Maximum = secondHighest
  31.  
  32. ' Expr1: Maximum ([nPP1CSF],[nPP2CSF],[nPP3CSF],[nPP4CSF],[nPP5CSF],[nPP6CSF],[nPP7CSF],[nPP8CSF],[nPP9CSF],[nPP0CSF])
  33.  
  34. End Function

Attached Images
File Type: jpg zMAX-SECOND.jpg (48.9 KB, 237 views)
Mar 3 '18 #1
Share this Question
Share on Google+
30 Replies


gnawoncents
100+
P: 212
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.

Expand|Select|Wrap|Line Numbers
  1. Function Maximum(ParamArray FieldArray() As Variant)
  2. ' Declare the two local variables.
  3. Dim I As Integer
  4. Dim currentVal As Integer
  5. Dim secondHighest As Integer
  6. Dim intCount As Integer
  7.  
  8. ' Set the variable currentVal equal to the array of values.
  9. currentVal = FieldArray(0)
  10.  
  11. ' Cycle through each value from the row to find the largest.
  12. For I = 0 To UBound(FieldArray)
  13.     If FieldArray(I) > currentVal Then
  14.         currentVal = FieldArray(I)
  15.       ElseIf FieldArray(I) = currentVal Then
  16.         intCount = intCount + 1
  17.     End If
  18. Next
  19.  
  20. If intCount - 1 = UBound(FieldArray) Then
  21.     ' Return the starting value since they were all the same
  22.     Maximum = FieldArray(0) 'MODIFY THIS TO WHATEVER YOU WANT WHEN THEY ARE ALL THE SAME
  23.   Else
  24.     Dim tmpArray As Variant
  25.     tmpArray = Filter(FieldArray, currentVal, False, vbTextCompare)
  26.     ' This will fill the tmpArray with all your array values EXCEPT the highest one.
  27.  
  28.     secondHighest = tmpArray(0)
  29.  
  30.     For I = 0 To UBound(tmpArray)
  31.         If tmpArray(I) > secondHighest Then
  32.             secondHighest = tmpArray(I)
  33.         End If
  34.     Next
  35.  
  36.     ' Return the maximum value found.
  37.     Maximum = secondHighest
  38. End If
  39.  
  40. ' Expr1: Maximum ([nPP1CSF],[nPP2CSF],[nPP3CSF],[nPP4CSF],[nPP5CSF],[nPP6CSF],[nPP7CSF],[nPP8CSF],[nPP9CSF],[nPP0CSF])
  41.  
  42. End Function
  43.  
Mar 5 '18 #2

twinnyfo
Expert Mod 2.5K+
P: 2,720
liamthequietman,

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

Expand|Select|Wrap|Line Numbers
  1. Function Maximum(ParamArray FieldArray() As Variant)
  2. On Error GoTo EH
  3.     ' Declare the two local variables.
  4.     Dim I As Integer
  5.     Dim currentVal As Integer
  6.     Dim secondHighest As Integer
  7.     Dim intCount As Integer
  8.  
  9.     ' Set the variable currentVal equal to the array of values.
  10.     currentVal = FieldArray(0)
  11.  
  12.     ' Cycle through each value from the row to find the largest.
  13.     For I = 0 To UBound(FieldArray)
  14.         If FieldArray(I) = currentVal Then intCount = intCount + 1
  15.         If FieldArray(I) > currentVal Then
  16.             secondHighest = currentVal
  17.             currentVal = FieldArray(I)
  18.         Else
  19.             If FieldArray(I) > secondHighest _
  20.                 And FieldArray(I) < currentVal Then
  21.                 secondHighest = FieldArray(I)
  22.             End If
  23.         End If
  24.     Next
  25.  
  26.     If intCount - 1 = UBound(FieldArray) Then
  27.         ' Return the starting value since they were all the same
  28.         Maximum = FieldArray(0) 'MODIFY THIS TO WHATEVER YOU WANT WHEN THEY ARE ALL THE SAME
  29.     Else
  30.         ' Return the maximum value found.
  31.         Maximum = secondHighest
  32.     End If
  33.  
  34.     Exit Function
  35. EH:
  36.     MsgBox "There was an error finding the second highest value!  " & _
  37.         "Please contact your Database Administrator.", vbCritical, "WARNING!"
  38.     Exit Function
  39. 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!
Mar 5 '18 #3

gnawoncents
100+
P: 212
twinnyfo,

Very nice--much more elegant. *initiates slow clap*
Mar 5 '18 #4

twinnyfo
Expert Mod 2.5K+
P: 2,720
gnawoncents,

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

:-P
Mar 5 '18 #5

P: 13
BRILLIANT!

What an excellent collaboration between the two of you!

I hope others can benefit from this excellent code.

I'm very grateful!
Mar 5 '18 #6

twinnyfo
Expert Mod 2.5K+
P: 2,720
Glad the two of us could hepp!
Mar 5 '18 #7

P: 13
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)

Expand|Select|Wrap|Line Numbers
  1. Function Minimum(ParamArray FieldArray() As Variant)
  2.     On Error GoTo EH
  3.         ' Declare the two local variables.
  4.         Dim I As Integer
  5.         Dim currentVal As Single
  6.         Dim secondLowest As Single
  7.         Dim intCount As Integer
  8.  
  9.         ' Set the variable currentVal equal to the array of values.
  10.         currentVal = FieldArray(0)
  11.  
  12.         ' Cycle through each value from the row to find the lowest.
  13.         For I = 0 To UBound(FieldArray)
  14.             If FieldArray(I) = currentVal Then intCount = intCount + 1
  15.             If FieldArray(I) < currentVal Then
  16.                 secondLowest = currentVal
  17.                 currentVal = FieldArray(I)
  18.             Else
  19.                 If FieldArray(I) < secondLowest _
  20.                     And FieldArray(I) > currentVal Then
  21.                     secondLowest = FieldArray(I)
  22.                 End If
  23.             End If
  24.         Next
  25.  
  26.         If intCount - 1 = UBound(FieldArray) Then
  27.             ' Return the starting value since they were all the same
  28.             Minimum = FieldArray(0) 'Modify this to whatever you want when they are all the same
  29.         Else
  30.             ' Return the Minimum value found.
  31.             Minimum = secondLowest
  32.         End If
  33.  
  34.         Exit Function
  35. EH:
  36.         MsgBox "There was an error finding the second Lowest value!  " & _
  37.             "Please contact your Database Administrator.", vbCritical, "WARNING!"
  38.         Exit Function
  39.  
  40. ' Expr1: Minimum([nPP1SHF],[nPP2SHF],[nPP3SHF],[nPP4SHF],[nPP5SHF],[nPP6SHF],[nPP7SHF],[nPP8SHF],[nPP9SHF],[nPP0SHF])
  41.  
  42. End Function
Attached Images
File Type: jpg zMIN-SECOND.jpg (58.3 KB, 20 views)
Mar 5 '18 #8

twinnyfo
Expert Mod 2.5K+
P: 2,720
All you need to do is reverse you ">" and "<" operators.
Mar 5 '18 #9

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

Thanks!
Mar 5 '18 #10

twinnyfo
Expert Mod 2.5K+
P: 2,720
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.
Mar 5 '18 #11

twinnyfo
Expert Mod 2.5K+
P: 2,720
What happens when there is a -1 in any of the values. It should work with positive or negative numbers.
Mar 5 '18 #12

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

My apologies!
Mar 5 '18 #13

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

see pic in post I edited
Mar 5 '18 #14

twinnyfo
Expert Mod 2.5K+
P: 2,720
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?
Mar 5 '18 #15

P: 13
If there is a column(s) with a -1 it is returning the lowest number, not the second lowest.

Columns without -1 are returning the correct second lowest number

Columns with all -1 returns -1 which is perfect
Attached Images
File Type: jpg Capture.jpg (59.8 KB, 21 views)
Mar 5 '18 #16

twinnyfo
Expert Mod 2.5K+
P: 2,720
Have you stepped through the code while it is running to see how the evaluations of the values are working? Particularly, when there is a -1 value and the code gets here:

Expand|Select|Wrap|Line Numbers
  1. If FieldArray(I) < currentVal Then
  2.     secondLowest = currentVal
  3.     currentVal = FieldArray(I)
  4. Else
  5.     If FieldArray(I) < secondLowest _
  6.         And FieldArray(I) > currentVal Then
  7.         secondLowest = FieldArray(I)
  8.     End If
  9. End If
How are the evaluations responding?

Not sure if it has anything to do with it, but you may need to declare your array as a Double?

Expand|Select|Wrap|Line Numbers
  1. Function Minimum(ParamArray FieldArray() As Double)
Mar 5 '18 #17

P: 13
Being a complete VBA novice, I'm not familiar on how to step through the code. I placed my cursor in the code and pressed F8 and received a ping which I associate with an error.

Declaring the array as Double resulted in a error
Mar 5 '18 #18

twinnyfo
Expert Mod 2.5K+
P: 2,720
No worries, we've all been novices at one point.

Before you run your code, click your mouse to the left of the first line of your function in the VBA editor. It should leave a dark brown circle in the left margin. Run your code and the code should stop at that point (called a break point). Then, hit F8 repeatedly to watch the code work through itself. Any time the code is paused, you can hover your mouse over any of the variables and you will be able to see their current values.

Hope that hepps!
Mar 5 '18 #19

P: 13
Thanks for not giving up on this project!

My step through attempt did not work, a Macro box appears (see pic).

I found another issue with the results. In review:

CORRECT

Columns without -1 are returning the correct second lowest number

Columns with all -1 returns -1 which is perfect

INCORRECT

If there is a column(s) with a -1 it is returning the lowest number, not the second lowest.

If there are columns with identical numbers it's returning zero
Attached Images
File Type: jpg code.jpg (41.5 KB, 16 views)
Mar 5 '18 #20

twinnyfo
Expert Mod 2.5K+
P: 2,720
By "running your code", I mean you have to execute it the way you would normally execute it. Then, when the code hits your break point, then you can step through it using F8. Hope that hepps.
Mar 5 '18 #21

twinnyfo
Expert Mod 2.5K+
P: 2,720
Or, maybe try using the values -2 and -1.2 to see if that will have any effect on the logic the code returns. At this point, I am grasping at straws, because based upon what I am seeing int he code, it "should" work, but it just doesn't. I must be missing something obvious, which would not be the first time something like that happened.
Mar 5 '18 #22

twinnyfo
Expert Mod 2.5K+
P: 2,720
Was able to do some testing and proofing. Note lines 23-31. We forgot about the situation when the first number is the lowest. We never checked to see if the second was still the lowest value. This should solve it.

Expand|Select|Wrap|Line Numbers
  1. Public Function Minimum(FieldArray() As Variant) As Single
  2. On Error GoTo EH
  3.     ' Declare the two local variables.
  4.     Dim I               As Integer
  5.     Dim currentVal      As Single
  6.     Dim secondLowest    As Single
  7.     Dim intCount        As Integer
  8.  
  9.     ' Set the variable currentVal equal to the array of values.
  10.     currentVal = FieldArray(0)
  11.     secondLowest = FieldArray(0)
  12.  
  13.     ' Cycle through each value from the row to find the lowest.
  14.     For I = 0 To UBound(FieldArray)
  15.         If FieldArray(I) = currentVal Then intCount = intCount + 1
  16.         If FieldArray(I) < currentVal Then
  17.             secondLowest = currentVal
  18.             currentVal = FieldArray(I)
  19.         ElseIf secondLowest = currentVal _
  20.             And FieldArray(I) > secondLowest Then
  21.                 secondLowest = FieldArray(I)
  22.         Else
  23.             If secondLowest = currentVal _
  24.                 And FieldArray(I) > secondLowest Then
  25.                 secondLowest = FieldArray(I)
  26.             Else
  27.                 If FieldArray(I) < secondLowest _
  28.                     And FieldArray(I) > currentVal Then
  29.                     secondLowest = FieldArray(I)
  30.                 End If
  31.             End If
  32.         End If
  33.     Next
  34.  
  35.     If intCount - 1 = UBound(FieldArray) Then
  36.         ' Return the starting value since they were all the same
  37.         Minimum = FieldArray(0) 'Modify this to whatever you want when they are all the same
  38.     Else
  39.         ' Return the Minimum value found.
  40.         Minimum = secondLowest
  41.     End If
  42.  
  43.     Exit Function
  44. EH:
  45.     MsgBox "There was an error finding the second Lowest value!  " & _
  46.         "Please contact your Database Administrator.", vbCritical, "WARNING!"
  47.     Exit Function
  48. End Function
Mar 5 '18 #23

P: 13
Can I attach a test version of my database?
Mar 5 '18 #24

twinnyfo
Expert Mod 2.5K+
P: 2,720
Check my last post and see if that code works. It ran fine for me. I knew I was overlooking something obvious. It wasn't until I was able to step through the code that I found it.
Mar 5 '18 #25

P: 13
I applaud you for your tenacity! The expression I enter into the query has worked in all your codes except now. Error wrong number of arguments:

Expr1: Minimum([nPP1SHF],[nPP2SHF],[nPP3SHF],[nPP4SHF],[nPP5SHF],[nPP6SHF],[nPP7SHF],[nPP8SHF],[nPP9SHF],[nPP0SHF])
Mar 5 '18 #26

twinnyfo
Expert Mod 2.5K+
P: 2,720
I changed Line 1 from:

Expand|Select|Wrap|Line Numbers
  1. Public Function Minimum(ParamArray FieldArray() As Variant) As Single
to:

Expand|Select|Wrap|Line Numbers
  1. Public Function Minimum(FieldArray() As Variant) As Single
Not sure if that makes a difference. I couldn't get it to work any other way.

I was using my code from within VBA, you are calling it as an expression in a Query, which is causing the disconnect.
Mar 5 '18 #27

P: 13
I found a code which works perfect EXCEPT ...

If there is a column(s) with a -1 it is returning the lowest number, not the second lowest.

Otherwise all the result are correct.

Expand|Select|Wrap|Line Numbers
  1. Function SecondMinimum(ParamArray FieldArray() As Variant) As Variant
  2.     Dim I As Integer
  3.     Dim LowestVal As Variant
  4.     Dim secondVal As Variant
  5.  
  6. '   Default values
  7.     LowestVal = Null
  8.     secondVal = Null
  9.  
  10. '   Populate the LowestVal and secondVal temporary variables
  11.     For I = 0 To UBound(FieldArray)
  12.         If IsNull(FieldArray(I)) = False Then
  13.             If IsNull(LowestVal) Then
  14.                 LowestVal = FieldArray(I)
  15.             ElseIf IsNull(secondVal) Then
  16. '               Before populating the secondVal, make sure LowestVal will be
  17. '               less than or equal to secondVal.
  18.                 If FieldArray(I) > LowestVal Then
  19.                     secondVal = FieldArray(I)
  20.                 Else
  21.                     secondVal = LowestVal
  22.                     LowestVal = FieldArray(I)
  23.                 End If
  24.                 Exit For
  25.             End If
  26.         End If
  27.     Next I
  28.  
  29. '   Make sure there are at least two non-Null values in the temporary variables
  30.     If IsNull(LowestVal) = False And IsNull(secondVal) = False Then
  31.  
  32. '       Loop through the array values, comparing them to the lowest and second-lowest
  33.         For I = 0 To UBound(FieldArray)
  34. '           Skip duplicate values.
  35.             If FieldArray(I) <> LowestVal Then
  36. '               New lowest value?
  37.                 If FieldArray(I) < LowestVal Then
  38. '                   New lowest value.  Push the Lowest up to second, then make this
  39. '                   array value the new lowest value.
  40.                     secondVal = LowestVal
  41.                     LowestVal = FieldArray(I)
  42. '               Skip duplicate values.
  43.                 ElseIf FieldArray(I) <> secondVal Then
  44. '                   New second-lowest value?
  45.                     If FieldArray(I) < secondVal Then
  46. '                       Replace the second-lowest value with the current array value.
  47.                         secondVal = FieldArray(I)
  48.                     End If
  49.                 End If
  50.             End If
  51.         Next I
  52.     End If
  53.  
  54. '   This function will return Null if less than 2 non-Null values were passed.
  55.     SecondMinimum = secondVal
  56.  
  57.     ' Expr1: SecondMinimum([nPP1SHF],[nPP2SHF],[nPP3SHF],[nPP4SHF],[nPP5SHF],[nPP6SHF],[nPP7SHF],[nPP8SHF],[nPP9SHF],[nPP0SHF])
  58.  
  59. End Function
  60.  
Mar 5 '18 #28

twinnyfo
Expert Mod 2.5K+
P: 2,720
Did you adjust your code to match what I provided? It worked perfectly for me with all values.
Mar 5 '18 #29

P: 13
I just ran the code in post #23. When I place the expression into the query I receive, error wrong number of arguments:

Expr1: Minimum([nPP1SHF],[nPP2SHF],[nPP3SHF],[nPP4SHF],[nPP5SHF],[nPP6SHF],[nPP7SHF],[nPP8SHF],[nPP9SHF],[nPP0SHF])
Mar 5 '18 #30

twinnyfo
Expert Mod 2.5K+
P: 2,720
Did you change line 1 as discussed in post #27?
Mar 6 '18 #31

Post your reply

Sign in to post your reply or Sign up for a free account.