View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Toppers Toppers is offline
external usenet poster
 
Posts: 4,339
Default Need to expand Macro

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

"nander" wrote:


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 |
+-------------------------------------------------------------------+

--
nander
------------------------------------------------------------------------
nander's Profile: http://www.excelforum.com/member.php...fo&userid=6156
View this thread: http://www.excelforum.com/showthread...hreadid=515592