Function to return a rating

[jjames]

I need a function that will return a number which is an index into a array of color values. These colors represent a rating, Red = Bad, Yellow = Ok, Green = Good, etc. There are 7 possible values that can be returned. For purposes of illustration...

1 = Red
2 = Lt Red
3 = Redish Green
4 = Yellow
5 = Greenish Red
6 = Lt Green
7 = Green

My call to the function would look like this...

lngMin = 0
lngMax = 10
lngValue = 4

lngColorIndex = GetColorIndex(lngMin, lngMax, lngValue)

lngMin and lngMax are the range of values allowed. The minimum value at this time would always be 0 but the maximum value can be anything, 0 to 1, 0 to 3, 0 to 10, 0 to 230, etc.

The function itself may look like this...

Private Function GetColorIndex(Min as Long, Max as Long, Value as Long) as long 

if Value = Min then 
    GetColorIndex = 1 'Red 
ElseIf Value = Max then
    GetColorIndex = 7 'Green
else
    'this is where I get stuck
    'GetColorIndex = n

    'At this point n cannot be 1 or 7

    'Need to calculate rating based on range of values
    'and the actual value

Endif

So in this case where

lngMin = 0
lngMax = 10
lngValue = 4

GetColorIndex would return a 3

Value ColorIndex
0 = 1
1 - 2 = 2
3 - 4 = 3
5 = 4
6 - 7 = 5
8 - 9 = 6
10 = 7


or if

lngMin = 0
lngMax = 3
lngValue = 2

GetColorIndex would return a 5

Value ColorIndex
0 = 1
= 2
1 = 3
= 4
2 = 5
= 6
10 = 7

Thanks for any help, I've been looking at this problem off and on for days and just can't get my head around it.

 

[johnwm]

Look up the Select Case statement

________________________________________________________________
If you want to get the best response to a question, please check out FAQ222-2244 first.
'If we're supposed to work in Hex, why have we only got A fingers?'
Essex Steam UK for steam enthusiasts

 

[jjames]

The last example should read...

lngMin = 0
lngMax = 3
lngValue = 2

GetColorIndex would return a 5

Value ColorIndex
0 = 1
= 2
1 = 3
= 4
2 = 5
= 6
3 = 7

Sorry for any confusion.

 

[jjames]

Thanks for your reply Johnwm but I don't know how a Select Case will help when the range of values can change with each call to the function.

 

[Hypetia]

A simple math equation will do the trick.
___
[tt]
Function GetColorIndex(Min As Long, Max As Long, Value As Long) As Long
GetColorIndex = Int((Value - Min) / (Max - Min) * 6) + 1
End Function[/tt]

 

[ChewDoggie]

IF max CAN be zero then better to check:


Function GetColorIndex(Min As Long, Max As Long, Value As Long) As Long
if (Max - Min) <> 0 then
GetColorIndex = Int((Value - Min) / (Max - Min) * 6) + 1
End if
End Function


ciao for niao!

AMACycle

American Motorcyclist Association

http://www.ama-cycle.org

 

[Sheco]

How will you decide which colors to use when the range is less than the number of colors?

Say for example that your range is 0 to 4... that is only 5 colors... you have 7 to choose from... the 4 will be green ad the 0 will be red but what about the others ?

 

[BobRodes]

I agree with Hypetia. One thing, though: are you definitely going to use 7 color values to choose from? If not, you need to pass in a value, which in Hypetia's equation would be substituted for the 6.

Bob

 

[jjames]

Thank you all for your replies. I can't believe it's been almost 2 weeks since I looked at this problem. I thought at first that Hypetia's solution was the one but it did not quite work properly. Anyhow, to get the result that I described above, I did this. Not very eloquent, but it works.

Public Function GetColorIndex(ByVal sngMinValue As Long, ByVal sngMaxValue As Long, ByVal sngValue As Long) As Long
    Dim lBase As Long
    Dim lMod As Long
    Dim aValues() As Long
    Dim lIndex As Long
    Dim lColorValue As Long
    Dim c As Long
    Dim lExtra As Long
    Dim bMiddle As Boolean
    
    If sngValue = sngMinValue Then
    
        GetColorIndex = 1 'Red
        
    ElseIf sngValue = sngMaxValue Then
    
        GetColorIndex = 7 'Green
        
    ElseIf sngValue > sngMaxValue Then
    
        GetColorIndex = 7 + 1 'Blue
        
    Else 'all others in between
    
        ReDim aValues(sngMinValue To sngMaxValue)
        
        lBase = Int((sngMaxValue - 1) / 4) - 1
        lMod = (sngMaxValue - 1) Mod 4
        
        Select Case lMod
        
            Case 0 'no middle and no extra
                bMiddle = False
                lExtra = 0
                
            Case 1 'middle but no extra
                bMiddle = True
                lExtra = 0
            
            Case 2 'no middle but a extra
                bMiddle = False
                lExtra = 1
            
            Case 3 'middle and extra
                bMiddle = True
                lExtra = 1
                
        End Select
        
        lIndex = 1
        
        For c = 0 To lBase
            aValues(lIndex) = 2
            lIndex = lIndex + 1
        Next
        
        For c = 0 To lBase + lExtra
            aValues(lIndex) = 3
            lIndex = lIndex + 1
        Next
        
        If bMiddle Then
            aValues(lIndex) = 4
            lIndex = lIndex + 1
        End If
        
        For c = 0 To lBase + lExtra
            aValues(lIndex) = 5
            lIndex = lIndex + 1
        Next
        
        For c = 0 To lBase
            aValues(lIndex) = 6
            lIndex = lIndex + 1
        Next
                    
        GetColorIndex = aValues(sngValue)
    
    End If
    
End Function

 

[Hypetia]

jjames, using your function, I get the following results.

GetColorIndex(1, 7, 2) = 3 (instead of 2)
GetColorIndex(1, 7, 4) = 5 (instead of 4)
GetColorIndex(2, 8, 5) = Subscript out of range error (instead of 4)

Do you think these results are okay?

 

[jjames]

Hi Hypetia,

I've only tested this function where the minimum value is always 0 which is ok for my purposes.