| Home |
| Search |
| Today's Posts |
|
|
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Need to expand Macro
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 |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
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 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Need to expand Macro
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 "Toppers" wrote: 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 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| expand row to fit | Excel Worksheet Functions | |||
| Looking to Expand on Text to Columns Macro | Excel Discussion (Misc queries) | |||
| Dana: help with your Demo() macro to "expand" formulas | Excel Worksheet Functions | |||
| Use a macro to expand data series for chart? | Charts and Charting in Excel | |||
| Macro to expand formulas to additional rows | Excel Discussion (Misc queries) | |||
Hybrid Mode
