Need to expand Macro

Thread view:

Enable EMail Alerts

Start New Thread

Thread rating:

nander - 23 Feb 2006 02:50 GMT

How do I expand this macro from ABC to A+ A B C D?

Public Function ABCRank(Test_Value As Single, Test_Range As Range,
Upper_Cutoff As Single, Lower_Cutoff As Single)

Application.Volatile

Dim A_Rank As Single
Dim B_Rank As Single
Dim C_Rank As Single

A_Rank = Excel.WorksheetFunction.Percentile(Test_Range,
Upper_Cutoff)
A_Rank = Format(A_Rank, "0.00")
C_Rank = Excel.WorksheetFunction.Percentile(Test_Range,
Lower_Cutoff)
C_Rank = Format(C_Rank, "0.00")

Select Case Test_Value
Case Is >= A_Rank
ABCRank = "A"
Case Is <= C_Rank
ABCRank = "C"
Case Else
If Test_Value < A_Rank And Test_Value > C_Rank Then
ABCRank = "B"
Else
ABCRank = "Error"
End If
End Select

End Function

+-------------------------------------------------------------------+

|Filename: ABC-1.zip |
|Download: http://www.excelforum.com/attachment.php?postid=4391 |

+-------------------------------------------------------------------+

Signature

nander

Reply to this Message

Toppers - 23 Feb 2006 06:01 GMT

This is UNTESTED: if the cutoffs are non-volatile, you could hold them as an
array in the function, pass only the test value, and compare this against the
array.

Public Function ABCRank(Test_Value As Single, Test_Range As Range, _
AA_Cutoff As Single, A_Cutoff As Single, B_Cutoff As Single, C_Cutoff As
Single)

Application.Volatile

Dim AA_Rank As Single
Dim A_Rank As Single
Dim B_Rank As Single
Dim C_Rank As Single

AA_Rank = Excel.WorksheetFunction.Percentile(Test_Range, AA_Cutoff)
AA_Rank = Format(AA_Rank, "0.00")
A_Rank = Excel.WorksheetFunction.Percentile(Test_Range, A_Cutoff)
A_Rank = Format(A_Rank, "0.00")
B_Rank = Excel.WorksheetFunction.Percentile(Test_Range, B_Cutoff)
B_Rank = Format(B_Rank, "0.00")
C_Rank = Excel.WorksheetFunction.Percentile(Test_Range, C_Cutoff)
C_Rank = Format(C_Rank, "0.00")

Select Case Test_Value
Case Is >= AA_Rank
ABCRank = "A+"
Case Is >= A_Rank
ABCRank = "A"
Case Is >= B_Rank
ABCRank = "B"
Case Is <= D_Rank
ABCRank = "D"
Case Else
If Test_Value < B_Rank And Test_Value > D_Rank Then
ABCRank = "C"
Else
ABCRank = "Error"
End If
End Select

> How do I expand this macro from ABC to A+ A B C D?
>
[quoted text clipped - 33 lines]
> |Download: http://www.excelforum.com/attachment.php?postid=4391 |
> +-------------------------------------------------------------------+

Reply to this Message

Toppers - 23 Feb 2006 06:11 GMT

Sorry - mistake in previous version (this is still untested):

Public Function ABCRank(Test_Value As Single, Test_Range As Range, _
AA_Cutoff As Single, A_Cutoff As Single, B_Cutoff As Single, D_Cutoff As
Single)

Application.Volatile

Dim AA_Rank As Single
Dim A_Rank As Single
Dim B_Rank As Single
Dim D_Rank As Single

AA_Rank = Excel.WorksheetFunction.Percentile(Test_Range, AA_Cutoff)
AA_Rank = Format(AA_Rank, "0.00")
A_Rank = Excel.WorksheetFunction.Percentile(Test_Range, A_Cutoff)
A_Rank = Format(A_Rank, "0.00")
B_Rank = Excel.WorksheetFunction.Percentile(Test_Range, B_Cutoff)
B_Rank = Format(B_Rank, "0.00")
D_Rank = Excel.WorksheetFunction.Percentile(Test_Range, D_Cutoff)
D_Rank = Format(D_Rank, "0.00")

Select Case Test_Value
Case Is >= AA_Rank
ABCRank = "A+"
Case Is >= A_Rank
ABCRank = "A"
Case Is >= B_Rank
ABCRank = "B"
Case Is <= D_Rank
ABCRank = "D"
Case Else
If Test_Value < B_Rank And Test_Value > D_Rank Then
ABCRank = "C"
Else
ABCRank = "Error"
End If
End Select

End Function

> This is UNTESTED: if the cutoffs are non-volatile, you could hold them as an
> array in the function, pass only the test value, and compare this against the
[quoted text clipped - 74 lines]
> > |Download: http://www.excelforum.com/attachment.php?postid=4391 |
> > +-------------------------------------------------------------------+

Reply to this Message