Which loop to use? (1 Viewer)

Mr_Si

Registered User.
Local time
Today, 16:16
Joined
Dec 8, 2007
Messages
163
SOLVED: Which loop to use?

Hi there,

I'm trying to work out which loop I need to use or if I need to use a mix of loops.

The context is as follows:

I have a table of absorption values for each material.
I have a button which calculates which class of absorber the material is, based on its 5 values
Classes are A to E, plus unclassified. (A is the best, Unclassified is the worst)

The 5 values are stored in an array and so I want to loop through this array and find the lowest value and return that one.

For example, if out of the 5 values in the array, the first two are a D, the second two are an E and the last one is a D, I would want to stop at the first E and return "E".

I have made my code so far as a For Each loop, but it goes through all 5 values and the result is the last one, regardless and I am stuck. Do I need, for example to use a "Do While" type loop instead? If so, I've never used one of these before and would probably need some asssistance.


My code is as follows (the first bit is the calculation and then the loop comes later):

Code:
Private Sub btnClassCalculate_Click()
    Dim strClass(0 To 4) As String
    Dim Str As Variant
    
    Erase strClass
            
    Select Case Me.num250Hz
        Case 0.7 To 1
            strClass(0) = "A"
        Case 0.6 To 0.7
            strClass(0) = "B"
        Case 0.4 To 0.6
            strClass(0) = "C"
        Case 0.1 To 0.4
            strClass(0) = "D"
        Case Is < 0.1
            strClass(0) = "E"
    End Select
        
    Select Case Me.num500Hz
        Case 0.92 To 1
            strClass(1) = "A"
        Case 0.84 To 0.92
            strClass(1) = "B"
        Case 0.64 To 0.84
            strClass(1) = "C"
        Case 0.32 To 0.64
            strClass(1) = "D"
        Case 0.16 To 0.32
            strClass(1) = "E"
        Case Is < 0.16
            strClass(1) = "U"
    End Select
        
    Select Case Me.num1kHz
        Case 0.92 To 1
            strClass(2) = "A"
        Case 0.84 To 0.92
            strClass(2) = "B"
        Case 0.64 To 0.84
            strClass(2) = "C"
        Case 0.32 To 0.64
            strClass(2) = "D"
        Case 0.16 To 0.32
            strClass(2) = "E"
        Case Is < 0.16
            strClass(2) = "U"
    End Select
        
    Select Case Me.num2kHz
        Case 0.92 To 1
            strClass(3) = "A"
        Case 0.84 To 0.92
            strClass(3) = "B"
        Case 0.64 To 0.84
            strClass(3) = "C"
        Case 0.32 To 0.64
            strClass(3) = "D"
        Case 0.16 To 0.32
            strClass(3) = "E"
        Case Is < 0.16
            strClass(3) = "U"
    End Select
    
    Select Case Me.num4kHz
        Case 0.8 To 1
            strClass(4) = "A"
        Case 0.72 To 0.8
            strClass(4) = "B"
        Case 0.51 To 0.72
            strClass(4) = "C"
        Case 0.24 To 0.51
            strClass(4) = "D"
        Case Is < 0.24
            strClass(4) = "E"
    End Select
    
    'loop through the array and search for class types.
    For Each Str In strClass
        Select Case Str
        
            Case Is = "U"
                MsgBox ("Unclassified Absorber") 'print message
                Me.chrAbsorptionClass = "Unclassified"
                Exit For
                    
            Case Is = "E"
                MsgBox "Class E exists" 'print message
                Me.chrAbsorptionClass = "E"
                Exit For
            
            Case Is = "D"
                MsgBox "Class D exists" 'print message
                Me.chrAbsorptionClass = "D"
                Exit For
        
            Case Is = "C"
                MsgBox "Class C exists" 'print message
                Me.chrAbsorptionClass = "C"
                Exit For
            
            Case Is = "B"
                MsgBox "Class B exists" 'print message
                Me.chrAbsorptionClass = "B"
                Exit For
            
            Case Else
                MsgBox "Class A exists" 'print message
                Me.chrAbsorptionClass = "A"
                Exit For
            
        End Select
    Next
        
    Erase strClass
    
End Sub
I look forward to your help. Thank you in advance.
 
Last edited:

Mr_Si

Registered User.
Local time
Today, 16:16
Joined
Dec 8, 2007
Messages
163
Unless, of course, I don't need to loop and I just need something like MaxOfValue?
I.E: U > E > D > C > B > A
 

PeterF

Registered User.
Local time
Today, 17:16
Joined
Jun 6, 2006
Messages
295
You can do it without an array, simply test the value before setting the variable after the first Select case like:
Code:
    Select Case Me.num500Hz
        Case 0.92 To 1
            if strClass < "A" then strClass = "A"
        Case 0.84 To 0.92
            if strClass < "B" then strClass = "B"
        Case 0.64 To 0.84
            if strClass < "C" then strClass = "C"
        Case 0.32 To 0.64
            if strClass < "D" then strClass = "D"
        Case 0.16 To 0.32
            if strClass < "D" then strClass = "D"
        Case Is < 0.16
             if strClass < "U" then strClass = "U"
    End Select
This way strClass holds only the worst score.
 

Mr_Si

Registered User.
Local time
Today, 16:16
Joined
Dec 8, 2007
Messages
163
Thanks for that, but there would still need to be an array as it would hold a value for 5 different things.

I probably didn't explain properly - There is a value for
250 Hz,
500 Hz,
1 kHz,
2 kHz and
4 kHz

So these will need to then be stored somewhere so that I can then find the lowest one.
I'm now using numbers instead of letters and having a go with DMin / DMax instead.

Thanks,
Simon
 

dsaddan

New member
Local time
Today, 18:16
Joined
Dec 16, 2013
Messages
3
I am confused by your code in this section:
Code:
    For Each Str In strClass
        Select Case Str
        
            Case Is = "U"
                MsgBox ("Unclassified Absorber") 'print message
                Me.chrAbsorptionClass = "Unclassified"
                Exit For
...

You stated "but it goes through all 5 values and the result is the LAST one", to me it looks like your code takes the FIRST value in the array and exit the loop.

Is this what you need?
Code:
    Dim strMinValue as string
    strMinValue = "A" 'Init the min to the max value 

    For Each S In strClass
        Select Case S
        
            Case Is = "U"
                'We found an absolute min value, no need to keep on looking
                Exit For
                    
            Case Is = "E"
                If strMinValue > S Then strMinValue = "E"
            
            Case Is = "D"
                If strMinValue > S Then strMinValue = "D"
        
            Case Is = "C"
               If strMinValue > S Then strMinValue = "C"
             
            Case Is = "B"
               If strMinValue > S Then strMinValue = "B"

           Case Is = "A"
               If strMinValue > S Then strMinValue = "A"
             
            Case Else
               MsgBox "Unexpected value: " & S, vbCritical
             
        End Select
    Next

    Me.chrAbsorptionClass = S
 

Mr_Si

Registered User.
Local time
Today, 16:16
Joined
Dec 8, 2007
Messages
163
Hi there,

I am sorry, I had been playing with the code before I pasted it in, you're right, it would return the first from the code I pasted.

I actually got around it by finding a function called "MaxInArray" and using along with a another case statement, so no loops are used now.

I will mark this case as fixed.

Code:
Private Sub btnClassCalculate_Click()
    Dim intClass(0 To 4) As Variant
    
    Erase intClass
            
    Select Case Me.num250Hz
        Case 0.7 To 1
            intClass(0) = 1
        Case 0.6 To 0.7
            intClass(0) = 2
        Case 0.4 To 0.6
            intClass(0) = 3
        Case 0.1 To 0.4
            intClass(0) = 4
        Case Is < 0.1
            intClass(0) = 5
    End Select
        
    Select Case Me.num500Hz
        Case 0.92 To 1
            intClass(1) = 1
        Case 0.84 To 0.92
            intClass(1) = 2
        Case 0.64 To 0.84
            intClass(1) = 3
        Case 0.32 To 0.64
            intClass(1) = 4
        Case 0.16 To 0.32
            intClass(1) = 5
        Case Is < 0.16
            intClass(1) = 6
    End Select
        
    Select Case Me.num1kHz
        Case 0.92 To 1
            intClass(2) = 1
        Case 0.84 To 0.92
            intClass(2) = 2
        Case 0.64 To 0.84
            intClass(2) = 3
        Case 0.32 To 0.64
            intClass(2) = 4
        Case 0.16 To 0.32
            intClass(2) = 5
        Case Is < 0.16
            intClass(2) = 6
    End Select
        
    Select Case Me.num2kHz
        Case 0.92 To 1
            intClass(3) = 1
        Case 0.84 To 0.92
            intClass(3) = 2
        Case 0.64 To 0.84
            intClass(3) = 3
        Case 0.32 To 0.64
            intClass(3) = 4
        Case 0.16 To 0.32
            intClass(3) = 5
        Case Is < 0.16
            intClass(3) = 6
    End Select
    
    Select Case Me.num4kHz
        Case 0.8 To 1
            intClass(4) = 1
        Case 0.72 To 0.8
            intClass(4) = 2
        Case 0.51 To 0.72
            intClass(4) = 3
        Case 0.24 To 0.51
            intClass(4) = 4
        Case Is < 0.24
            intClass(4) = 5
    End Select

    Select Case MaxInArray(intClass)
        Case Is = 6
            Me.chrAbsorptionClass = "Unclassified"
        Case Is = 5
            Me.chrAbsorptionClass = "E"
        Case Is = 4
            Me.chrAbsorptionClass = "D"
        Case Is = 3
            Me.chrAbsorptionClass = "C"
        Case Is = 2
            Me.chrAbsorptionClass = "B"
        Case Is = 1
            Me.chrAbsorptionClass = "A"
    End Select
    
    Erase intClass
    
End Sub

function used as follows

Code:
Function MaxInArray(varArray As Variant) As Variant
' RETURN THE MAXIMUM VALUE FROM AN ARRAY

' FROM "VBA DEVELOPER'S HANDBOOK"
' BY KEN GETZ AND MIKE GILBERT
' COPYRIGHT 1997; SYBEX, INC. ALL RIGHTS RESERVED.

' IN: VARARRAY: A VALID ARRAY, CHECKED BY THE ISARRAY FUNCTION
' OUT: RETURN VALUE: THE MAXIMUM VALUE IN THE ARRAY

Dim varItem As Variant
Dim varMax As Variant
Dim intI As Integer

If IsArray(varArray) Then
    If UBound(varArray) = -1 Then
        MaxInArray = Null
    Else
        varMax = varArray(UBound(varArray))
        For intI = LBound(varArray) To UBound(varArray)
            varItem = varArray(intI)
            If varItem > varMax Then
                varMax = varItem
            End If
        Next intI
        MaxInArray = varMax
    End If
Else
    MaxInArray = Null
End If
End Function
 

Users who are viewing this thread

Top Bottom