• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 914
  • Last Modified:

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
0
ajaypappan
Asked:
ajaypappan
  • 5
  • 4
1 Solution
 
regmigrantCommented:
some more detail would be useful, snippet of code, what you're trying to achieve, why you are using rank and in what context


0
 
ajaypappanAuthor Commented:
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





0
 
ajaypappanAuthor Commented:
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
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
ajaypappanAuthor Commented:
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

0
 
regmigrantCommented:
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.

0
 
ajaypappanAuthor Commented:
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..
0
 
regmigrantCommented:
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
0
 
ajaypappanAuthor Commented:
see the attached file 60..is twice in that
rank.xls
0
 
regmigrantCommented:
Its treating the 60 as a label at the top of the column, thats why there is a delay while it tries to figure out where the label are.

Change the ranges to include row 1 and make sure columns h and I have the same header label
 rank-1.xls
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

  • 5
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now