UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Help Finding The Second Minimum Value With VBA, Access 2013    
 
   
Geek
post Apr 14 2014, 12:49 PM
Post#1



Posts: 7
Joined: 14-April 14



Hello,
I am trying to get this VBA code to pull the second minimum value within my data while ignoring NULLs. It seems to work on some rows, but not on others. I was wondering if anyone knows what I am doing wrong within the VBA and hopefully help me out!
Function Minimum(ParamArray FieldArray() As Variant)
Dim I As Integer
Dim currentVal As Variant
Dim secondVal As Variant
currentVal = FieldArray(0)
secondVal = FieldArray(0)
For I = 1 To UBound(FieldArray)
If IsNull(currentVal) Then
currentVal = FieldArray(I)
ElseIf FieldArray(I) < currentVal Then
currentVal = FieldArray(I)
' Finds Second Minimum
ElseIf secondVal > currentVal And FieldArray(I) < secondVal Then
secondVal = FieldArray(I)
End If
Next I
Minimum = secondVal
End Function

Thanks in advance!
Go to the top of the page
 
doctor9
post Apr 14 2014, 01:55 PM
Post#2


UtterAccess Editor
Posts: 18,324
Joined: 29-March 05
From: Wisconsin


Geek,
welcome2UA.gif
Just to clarify; when you say "the second minimum value", you mean the second-smallest unique value that isn't a Null, right? So, if you were to pass 1, Null, 3, Null, 7, and 9 to this function, you'd want to get the result of 3, right?
If I'm right, you should be more careful about how you populate your lowest and second-lowest variables. Try the code below. I've defined your function as a Variant type so it can return a Null value if less than two non-Null values are passed. You may want to change that if only 1 non-Null is passed, depending on what you're using this function for.
CODE
Function SecondMinimum(ParamArray FieldArray() As Variant) As Variant
    Dim I As Integer
    Dim LowestVal As Variant
    Dim secondVal As Variant
    
'   Default values
    LowestVal = Null
    secondVal = Null
    
'   Populate the LowestVal and secondVal temporary variables
    For I = 0 To UBound(FieldArray)
        If IsNull(FieldArray(I)) = False Then
            If IsNull(LowestVal) Then
                LowestVal = FieldArray(I)
            ElseIf IsNull(secondVal) Then
'               Before populating the secondVal, make sure LowestVal will be
'               less than or equal to secondVal.
                If FieldArray(I) > LowestVal Then
                    secondVal = FieldArray(I)
                Else
                    secondVal = LowestVal
                    LowestVal = FieldArray(I)
                End If
                Exit For
            End If
        End If
    Next I
    
'   Make sure there are at least two non-Null values in the temporary variables
    If IsNull(LowestVal) = False And IsNull(secondVal) = False Then
        
'       Loop through the array values, comparing them to the lowest and second-lowest
        For I = 0 To UBound(FieldArray)
'           Skip duplicate values.
            If FieldArray(I) <> LowestVal Then
'               New lowest value?
                If FieldArray(I) < LowestVal Then
'                   New lowest value.  Push the Lowest up to second, then make this
'                   array value the new lowest value.
                    secondVal = LowestVal
                    LowestVal = FieldArray(I)
'               Skip duplicate values.
                ElseIf FieldArray(I) <> secondVal Then
'                   New second-lowest value?
                    If FieldArray(I) < secondVal Then
'                       Replace the second-lowest value with the current array value.
                        secondVal = FieldArray(I)
                    End If
                End If
            End If
        Next I
    End If
    
'   This function will return Null if less than 2 non-Null values were passed.
    SecondMinimum = secondVal
End Function

I've added comments explaining what each bit does and why, but feel free to ask if you're confused about anything. For example, if you were to pass:
25, Null, 7, 17, 7, Null
...you'd get 17 as the second-lowest value. Again, depending on what you're doing, this may or may not be the answer you want.
Hope this helps,
Dennis
Go to the top of the page
 
Geek
post Apr 14 2014, 02:19 PM
Post#3



Posts: 7
Joined: 14-April 14



This is exactly what I was looking for!
Could this also work for finding the third minimum value if I were to edit it?
Thanks Again!!!!!!
Go to the top of the page
 
doctor9
post Apr 14 2014, 02:29 PM
Post#4


UtterAccess Editor
Posts: 18,324
Joined: 29-March 05
From: Wisconsin


Geek,
inding the third minimum would require more IF tests at every step. At that point, it would probably be more efficient to use code to sort the unique non-Null array values from lowest to highest, then return the Nth value.
Hope this helps,
Dennis
Go to the top of the page
 
Geek
post Apr 14 2014, 02:38 PM
Post#5



Posts: 7
Joined: 14-April 14



That makes perfect sense. Thanks again for your help with this! I am new to Access and VBA so you can imagine my frustration when I could not get my code to work! <
Go to the top of the page
 
doctor9
post Apr 14 2014, 02:57 PM
Post#6


UtterAccess Editor
Posts: 18,324
Joined: 29-March 05
From: Wisconsin


Geek,
Give this a shot. I must admit that this seemed like an interesting challenge, and a potentially useful bit of code.
I've implemented the absolutely slowest sorting algorithm around (the Bubble Sort), but it works. I also added a bit that removes duplicates from the list of values, so each one is unique. Depending on what you're using this for, you may want to remove that bit. There may be other ways to speed this function up, especially if it's being used in a query that returns a large number of records. But as is, it ought to work.
CODE
Function NthMinimum(intPosition As Integer, ParamArray FieldArray() As Variant) As Variant
'   Example syntax:
'   Debug.Print NthMinimum(2, 17, Null, 7, 25, 7, Null)
'   Result: 17   (Because 7 is the lowest, Nulls and duplicate values are ignored.)
'   If you ask for the 5th lowest value, but there are only 4 unique, non-Null values, the function returns a Null value.
    Dim varTempArray() As Variant, varTempValue As Variant, intArrayValues As Integer
    Dim I As Integer, J As Integer
    
    ReDim varTempArray(UBound(FieldArray))
    intArrayValues = 0
    
'   Transfer the non-Null values to a temporary array
    For I = 0 To UBound(FieldArray)
        If IsNull(FieldArray(I)) = False Then
            varTempArray(intArrayValues) = FieldArray(I)
            intArrayValues = intArrayValues + 1
        End If
    Next I
            
    If intArrayValues > 1 Then
'       Sort the temporary array, lowest to highest (Bubble sort)
        For I = 0 To intArrayValues - 2
            For J = I + 1 To intArrayValues - 1
                If varTempArray(J) < varTempArray(I) Then
                    varTempValue = varTempArray(J)
                    varTempArray(J) = varTempArray(I)
                    varTempArray(I) = varTempValue
                End If
            Next J
        Next I
    
'       Remove duplicate values
        I = 0
        While I < intArrayValues - 2
            If varTempArray(I) = varTempArray(I + 1) Then
                For J = I To intArrayValues - 1
                    varTempArray(J) = varTempArray(J + 1)
                Next J
                intArrayValues = intArrayValues - 1
            End If
            I = I + 1
        Wend
    End If
    If intPosition <= intArrayValues Then
        NthMinimum = varTempArray(intPosition - 1)
    Else
'       The requested position is higher than the number of values in the array
        NthMinimum = Null
    End If
End Function

Hope this helps,
Dennis
Go to the top of the page
 
Geek
post Apr 14 2014, 05:34 PM
Post#7



Posts: 7
Joined: 14-April 14



Doctor9,
This code works. I am amazed how quickly you came up with this code! Once again, thank you so much for your help on this!
Go to the top of the page
 
horseprofiler
post Mar 5 2018, 05:39 PM
Post#8



Posts: 17
Joined: 1-October 11



BRILLIANT code Doctor9!!

My data contains -1 and that's where the problem is. The code returns the second smallest value.

Result (20) 26 20 22 30 -1

Result (22) 26 20 22 30 24

Many thanks!
Go to the top of the page
 
doctor9
post Mar 6 2018, 09:23 AM
Post#9


UtterAccess Editor
Posts: 18,324
Joined: 29-March 05
From: Wisconsin


horseprofiler,

I'm not clear what your problem is. Which of the two above functions are you using? How are you calling it? What result would you prefer?

Dennis

--------------------
(;,;) Li'l Cthulu says: Please talk about what you're trying to do, as well as how you're doing it.
Changing your real table name to "Table1" and your real form name to "Form1" in your posts makes it more difficult to understand what's going on, not easier.
Guidelines for Posting Questions
Go to the top of the page
 
horseprofiler
post Mar 6 2018, 12:04 PM
Post#10



Posts: 17
Joined: 1-October 11



Thank you for your prompt response! I hope this clarifies things!

I use Function:

Function SecondMinimum(ParamArray FieldArray() As Variant) As Variant

Expression placed in Query:

Expr1: SecondMinimum([nPP1SHF],[nPP2SHF],[nPP3SHF],[nPP4SHF],[nPP5SHF],[nPP6SHF],[nPP7S
HF],[nPP8SHF],[nPP9SHF],[nPP0SHF])

The first column contains the results. Correct answers are in ( ) and incorrect in [ ]

(21.2) 21.6 21.2 25.2 22.8 23.2 24 23.2 24 19.2 22.4
[18.8] 48.4 28.4 25.6 18.8 -1 -1 -1 -1 -1 -1
[30] 36 30 -1 -1 -1 -1 -1 -1 -1 -1
(36) 36 -1 -1 -1 -1 -1 -1 -1 -1 -1
(-1) -1 -1 -1 -1 -1 -1 -1 -1 -1 -1

*Also see attached pic

Attached File(s)
Attached File  SecondLowest.PNG ( 24.09K )Number of downloads: 2
 
Go to the top of the page
 
doctor9
post Mar 6 2018, 01:16 PM
Post#11


UtterAccess Editor
Posts: 18,324
Joined: 29-March 05
From: Wisconsin


horseprofiler,

Pardon my confusion, but all of those results look correct.

How is 18.8 the wrong answer for "second lowest value" in (48.4, 28.4, 25.6, 18.8, -1, -1, -1, -1, -1, -1)?

Again... What result would you prefer?

Dennis

--------------------
(;,;) Li'l Cthulu says: Please talk about what you're trying to do, as well as how you're doing it.
Changing your real table name to "Table1" and your real form name to "Form1" in your posts makes it more difficult to understand what's going on, not easier.
Guidelines for Posting Questions
Go to the top of the page
 
horseprofiler
post Mar 6 2018, 03:28 PM
Post#12



Posts: 17
Joined: 1-October 11



I left out a big piece of the puzzle!

I failed to mention that if there is no value a -1 is placed in the column. The -1 is not considered in the calculation. Imagine the -1 fields are NULL.

Many thanks!
Go to the top of the page
 
doctor9
post Mar 6 2018, 03:42 PM
Post#13


UtterAccess Editor
Posts: 18,324
Joined: 29-March 05
From: Wisconsin


horseprofiler,

Did you try converting -1 values to Null in the function code? Or adding another IF test after the IsNull check?

CODE
    For I = 0 To UBound(FieldArray)
        
        If IsNull(FieldArray(I)) = False Then
            If FieldArray(I) <> -1 Then        '<-----NEW
                If IsNull(LowestVal) Then
                    LowestVal = FieldArray(I)
                ElseIf IsNull(secondVal) Then
    '               Before populating the secondVal, make sure LowestVal will be
    '               less than or equal to secondVal.
                    If FieldArray(I) > LowestVal Then
                        secondVal = FieldArray(I)
                    Else
                        secondVal = LowestVal
                        LowestVal = FieldArray(I)
                    End If
                    Exit For
                End If
            End If        '<--- NEW
        End If
    Next I


Hope this helps,

Dennis

--------------------
(;,;) Li'l Cthulu says: Please talk about what you're trying to do, as well as how you're doing it.
Changing your real table name to "Table1" and your real form name to "Form1" in your posts makes it more difficult to understand what's going on, not easier.
Guidelines for Posting Questions
Go to the top of the page
 


Custom Search
RSSSearch   Top   Lo-Fi    23rd June 2018 - 09:09 AM