Link to home
Start Free TrialLog in
Avatar of ajaypappan
ajaypappanFlag for United States of America

asked on

how to rank a column in vba

see my list i want to rank in vba..rank function fails because it skips second rank..

60
60
48
36
36
36
36
36
36
30
24
24
12
12
0
0
0
0
0
0
Avatar of regmigrant
regmigrant
Flag of United Kingdom of Great Britain and Northern Ireland image

some more detail would be useful, snippet of code, what you're trying to achieve, why you are using rank and in what context


Avatar of ajaypappan

ASKER

i want to rank the above list into first, second, third, No Win. Its part of a competition results..

here is my code

Public Sub assignRank()
Dim sCurrentVal
Dim sRange As Range


  Set sRange = ActiveWorkbook.Worksheets("18-40 Solo").Range("I10:I29")
   
  For iCount = 10 To WorksheetFunction.Count(ActiveWorkbook.Worksheets("18-40 Solo").Range("H10:H29")) + 9
    iRank = ""
    sCurrentVal = ActiveWorkbook.Worksheets("18-40 Solo").Range("I" & iCount).Value
 
   iRank = WorksheetFunction.Rank(sCurrentVal, sRange, 0)
    Debug.Print sCurrentVal & "," & iRank1
    Select Case iRank
    Case 1
            ActiveWorkbook.Worksheets("18-40 Solo").Range("J" & iCount).Value = "First"
    Case 2
            ActiveWorkbook.Worksheets("18-40 Solo").Range("J" & iCount).Value = "Second"
    Case 3
            ActiveWorkbook.Worksheets("18-40 Solo").Range("J" & iCount).Value = "Third"
    Case Else
                ActiveWorkbook.Worksheets("18-40 Solo").Range("J" & iCount).Value = "No Win"
    End Select
     
  Next

End Sub





this is more correct code..

Public Sub assignRank()
Dim sCurrentVal
Dim sRange As Range


  Set sRange = ActiveWorkbook.Worksheets("18-40 Solo").Range("H10:H29")
   
  For iCount = 10 To WorksheetFunction.Count(ActiveWorkbook.Worksheets("18-40 Solo").Range("H10:H29")) + 9
    iRank = ""
    sCurrentVal = ActiveWorkbook.Worksheets("18-40 Solo").Range("H" & iCount).Value
 
   iRank = WorksheetFunction.Rank(sCurrentVal, sRange, 0)
    Debug.Print sCurrentVal & "," & iRank1
    Select Case iRank
    Case 1
            ActiveWorkbook.Worksheets("18-40 Solo").Range("H" & iCount).Value = "First"
    Case 2
            ActiveWorkbook.Worksheets("18-40 Solo").Range("H" & iCount).Value = "Second"
    Case 3
            ActiveWorkbook.Worksheets("18-40 Solo").Range("H" & iCount).Value = "Third"
    Case Else
                ActiveWorkbook.Worksheets("18-40 Solo").Range("H" & iCount).Value = "No Win"
    End Select
     
  Next

End Sub
my problem is ranking "Second" is not available..

this is my result..
60      First
60      First
48      Third
36      No Win
36      No Win
36      No Win
36      No Win
36      No Win
36      No Win
30      No Win
24      No Win
24      No Win
12      No Win
12      No Win
0      No Win
0      No Win
0      No Win
0      No Win
0      No Win
0      No Win


Public Sub assignRank()
Dim sCurrentVal
Dim sRange As Range


  Set sRange = ActiveWorkbook.Worksheets("18-40 Solo").Range("H10:H29")
    
  For iCount = 10 To WorksheetFunction.Count(ActiveWorkbook.Worksheets("18-40 Solo").Range("H10:H29")) + 9
    iRank = ""
    sCurrentVal = ActiveWorkbook.Worksheets("18-40 Solo").Range("H" & iCount).Value
 
   iRank = WorksheetFunction.Rank(sCurrentVal, sRange, 0)
    Debug.Print sCurrentVal & "," & iRank1
    Select Case iRank
    Case 1
            ActiveWorkbook.Worksheets("18-40 Solo").Range("I" & iCount).Value = "First"
    Case 2
            ActiveWorkbook.Worksheets("18-40 Solo").Range("I" & iCount).Value = "Second"
    Case 3
            ActiveWorkbook.Worksheets("18-40 Solo").Range("I" & iCount).Value = "Third"
    Case Else
                ActiveWorkbook.Worksheets("18-40 Solo").Range("I" & iCount).Value = "No Win"
    End Select
      
  Next

End Sub

Open in new window

I think you are misunderstanding the 'rank' function and iits handling of duplicate numbers, in your example the first 60 would be ranked 1, the second 60 is also ranked 1 then 48 is ranked 3 - the rank of 2 is skipped because of the duplicated 60.

the only way to force it to work (as it stands) is to deduplicate the numbers first, rank the deduplicated set, and then lookup each result's rank against the resulting list.This would give
60 First
48 second
36 third
30 no win
and so on for a result rankingand then a comparison of each result to this table woult achieve your goal. There is also the possibility to rework the function so that the duplicated results gets a correcting factor applied so the second 60 would be ranked as 1.5 and so on but this could get messy if there are more than 2 'tied' results in any 1 list.

Depending on which version of excel you are using the Rank.EQ function might be what you are looking for.

I have excel 2003..let me know whats the work around..How to take the duplicates out and then integerate it back with the ranking..
Its difficult to give you worked examples because I don't know how your worksheet is structured but in principle:

1. Select the whole list of results
2. Use advanced filter to create a new list of unique records - see below
3. Use Rank function against the unique list to give a Unique Ranking List
4. Use vlookup against the results list to find the correct rank from the Unique Ranking List

If your results are in A2:A21 then give column B the same name as column A (ie: B1 = A1) and
this will put your Unique Results in B2:Bnn

Range("A1:A21").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
       "B1"), Unique:=True

You can now put the rankings in column C and a lookup in column D

the attached sheet shows it working in a spreadsheet.

To convert this to VBA code will need you to modify it to cope the various ranges of numbers (how many results, how many are unique) and decide how you want the output to look - is it acceptable to have a separate column showing rank or do you want a formatted ouput that is not connected to the results list?

From an outside view I would say that with the limited information you have provided the 'Ranking' function is uneccessary and you can handle the whole thing in the spreadsheet - but there may be reasons why you need the VBA function rank.xls
see the attached file 60..is twice in that
rank.xls
ASKER CERTIFIED SOLUTION
Avatar of regmigrant
regmigrant
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial