Using "RANK" inside vba WorkSheetFunction

[Fixador]

Hi Mark - thanks for that - will give it a whirl...............

..... and post a reply a little sooner than the last !

[Fixador]

Mark - This looks like the same problem with RANK again:-

the following cannot be done with RANK ( well, the way i code it ! )

e.g. if you had 2 ranked at 1 the new values would be 1.01 and 1.02

because RANK wont "2 ranked at 1 " . It misses the 2nd occassion, and I have a blank cell instead.

My data : From A1 down the Col : 3.8, 5.1, 4.6, 4.6, 21, 44, 27, 120

i have 2 2nd favs

my code:-

Code: Select all

Private Sub CommandButton1_Click()
'------------from GeorgeUK---------------------------------
    Dim firstmin As Range, scndmin As Range, thrdmin As Range, myrange As Range
    Dim z As Range, x As Integer, y As Integer
   
    Dim sht As Worksheet
    Set sht = ThisWorkbook.Worksheets(1)
    '---------------------------------------------------------------------------------
    Set myrange = sht.Range("a1:a8") 'if Col A range has the odds
   
    For Each z In myrange
        If WorksheetFunction.IsNumber(z.Value) = True Then
            x = WorksheetFunction.Rank(z.Value, myrange, 1)
            For y = 1 To 8 Step 1
                If x = y Then
                    sht.Cells(x, 2) = z ' this returns the Odds in descending order
                End If
            Next y
            '---------------------------------
            If x = 1 Then
                Set firstmin = z: Cells(10, 8) = z
            End If
            If x = 2 Then
                Set scndmin = z: Cells(11, 8) = z
            End If
            If x = 3 Then
               Set thrdmin = z: Cells(12, 8) = z
            End If
        End If
    Next z

[Fixador]

This gets rid of the empty cells in a meaningful way - gives them the odds of the cell above

Code: Select all

For i = 1 To 8 Step 1
        If Cells(i, 2) = "" Then
            Cells(i, 3) = Cells(i - 1, 2)
        Else:
            Cells(i, 3) = Cells(i, 2)
        End If
Next i


[Fixador]

whoops dead End .... changed code to return its Ranking number - not the odds in Rank

Code: Select all

Private Sub CommandButton2_Click()
'------------from GeorgeUK---------------------------------
    Dim firstmin As Range, scndmin As Range, thrdmin As Range, myrange As Range
    Dim z As Range, x As Integer, y As Integer
    Dim FirstFavRuns As Integer, SecFavRuns As Integer, ThirdFavRuns As Integer
    Dim sht As Worksheet, i As Integer, counter As Single
    Set sht = ThisWorkbook.Worksheets(1)
    '---------------------------------------------------------------------------------

    Range("B1:c8").ClearContents
   
    Set myrange = sht.Range("a1:a8") 'if Col A range has the odds
    counter = 0
    For Each z In myrange
        If WorksheetFunction.IsNumber(z.Value) = True Then
            x = WorksheetFunction.Rank(z.Value, myrange, 1)
            For y = 1 To 8 Step 1
                If x = y Then
                    'sht.Cells(x, 2) = z ' this returns the Odds in descending order
                    sht.Cells(y, 2) = x ' this returns the RANK number - whoops !
                End If
            Next y
            '---------------------------------
            If x = 1 Then
                Set firstmin = z: Cells(10, 8) = z
            End If
            If x = 2 Then
                Set scndmin = z: Cells(11, 8) = z
            End If
            If x = 3 Then
               Set thrdmin = z: Cells(12, 8) = z
            End If
        End If
    Next z


now, have same issue again, IF change A2 to 3.8 , so have 2 jt favs - then a blank cell appears in B2

Solution, the same as before

Code: Select all

For i = 1 To 8 Step 1
        If Cells(i, 2) = "" Then
            Cells(i, 3) = Cells(i - 1, 2)
        Else:
            Cells(i, 3) = Cells(i, 2)
        End If
    Next i


Now i can do incremental tie break on Col C

phew !

[Fixador]

crap - gone wrong again , cell B3 = 3 , B4 =4

should be cell B3 = 4 , B4 =3

[Fixador]

Back on track again ......

Code: Select all

Private Sub CommandButton1_Click()

    Dim firstmin As Range, scndmin As Range, thrdmin As Range, myrange As Range
    Dim x As Integer, y As Integer
    Dim FirstFavRuns As Integer, SecFavRuns As Integer, ThirdFavRuns As Integer
    Dim sht As Worksheet, i As Integer, counter As Single
    Set sht = ThisWorkbook.Worksheets(1)
    '---------------------------------------------------------------------------------

    Range("B1:f8").ClearContents
   
    Set myrange = sht.Range("a1:a8") 'if Col A range has the odds
    counter = 0
    For i = 1 To 8 Step 1
        If WorksheetFunction.IsNumber(i) = True Then
            x = WorksheetFunction.Rank(Cells(i, 1), myrange, 1) 'x is the Rank No.
            sht.Cells(i, 2) = x
        End If
    Next i
    '-------------------------------------------------------------------------------------
    'fill in the blank cells - do it in ColC so can see wot happens
    For i = 1 To 8 Step 1
        If Cells(i, 2) = "" Then
            Cells(i, 3) = Cells(i - 1, 2)
        Else:
            Cells(i, 3) = Cells(i, 2)
        End If
    Next i
    '-------------------------------------------------------------------------------------
    'now (1) generate the increment ( as reminder )
    '(2) Increment the RANKings
    For i = 1 To 8 Step 1
        If WorksheetFunction.IsNumber(sht.Cells(i, 3)) = True Then  ' check RANKed Odds are a number
       
                sht.Cells(i, 4) = counter + 0.01    'to show the incrementing
                sht.Cells(i, 5) = sht.Cells(i, 3) + counter   ' RANK this Col below
                counter = counter + 0.01
        End If
    Next i
End Sub

Now what the ##### is this

Then rank on these unique values and you have your ranking

[Fixador]

This is it ..... whatever it was i was trying to do....

Code: Select all

Private Sub CommandButton2_Click()

    Dim firstmin As Range, scndmin As Range, thrdmin As Range, myrange As Range
    Dim x As Integer, y As Integer
    Dim FirstFavRuns As Integer, SecFavRuns As Integer, ThirdFavRuns As Integer
    Dim sht As Worksheet, i As Integer, counter As Single
    Set sht = ThisWorkbook.Worksheets(1)
    '---------------------------------------------------------------------------------

    Range("B1:f8").ClearContents
   
    Set myrange = sht.Range("a1:a8") 'if Col A range has the odds
    counter = 0
    For i = 1 To 8 Step 1
        If WorksheetFunction.IsNumber(sht.Cells(i, 1)) = True Then
            x = WorksheetFunction.Rank(sht.Cells(i, 1), myrange, 1) 'x is the Rank No.
            sht.Cells(i, 2) = x
        End If
    Next i
    '-------------------------------------------------------------------------------------
    'fill in the blank cells - do it in ColC so can see wot happens
    For i = 1 To 8 Step 1
        If Cells(i, 2) = "" Then
            Cells(i, 3) = Cells(i - 1, 2)
        Else:
            Cells(i, 3) = Cells(i, 2)
        End If
    Next i
    '-------------------------------------------------------------------------------------
    'now (1) generate the increment ( as reminder )
    '(2) Increment the RANKings
    For i = 1 To 8 Step 1
        If WorksheetFunction.IsNumber(sht.Cells(i, 3)) = True Then  ' check RANKed Odds are a number
       
                sht.Cells(i, 4) = counter + 0.01    'to show the incrementing
                sht.Cells(i, 5) = sht.Cells(i, 3) + counter   ' RANK this Col below
                counter = counter + 0.01
        End If
    Next i
    '-------------------------------------------------------------------------------------
    'rank the rankings ??????
   
     Set myrange = sht.Range("e1:e8") 'if Col E range has the prior Rankings
     For i = 1 To 8 Step 1
        If WorksheetFunction.IsNumber(sht.Cells(i, 5)) = True Then
            x = WorksheetFunction.Rank(sht.Cells(i, 5), myrange, 1) 'x is the Rank No.
            sht.Cells(i, 6) = x
        End If
    Next i
    '-------------------------------------------------------------------------------------
    'Col F has my unique rankings
    '############## so list  first 3 favs  #####################
    For i = 1 To 3 Step 1
        For y = 1 To 8 Step 1
            If sht.Cells(y, 6) = i Then
                sht.Cells(y, 8) = i
            End If
        Next y
    Next i
End Sub



However, if have 2 jt favs , and 2 jt 2nd favs ..........it still dont work !

[dgs2001]

Fixador

Mark's suggestion of a rank tie break column does work, I think you may be confused slightly as I was when I first read it!.

The tie break numbers 0.01 etc are added to the Ranks Not to the odds this produces a new set of numbers which are then ranked again.

My data : From A1 down the Col : 3.8, 5.1, 4.6, 4.6, 21, 44, 27, 120

This produces the following ranks

3.8 Ranks 1 Add .01 = 1.01
5.1 Ranks 4 Add .02 = 4.02
4.6 Ranks 3 Add .03 = 3.03
4.6 Ranks 3 Add .04 = 3.04
21 Ranks 5 Add .05 = 5.05
etc

Now Rank The new Values

1.01 Ranks 1
4.02 Ranks 4
3.03 Ranks 2
3.04 Ranks 3
5.05 Ranks 5
etc

As you see the two matching odds are now ranked 2 and 3
Hope this helps

Duncan

[Fixador]

Hello Duncan - I have got it working in application ( at least twice ! ) - about 30 mins ago - yes i did hit a dead end , and eventually saw i was adding the increments to the odds - and not the rankings - wot a plonker I am ...eh !

Your right : Mark's brevity ............. ..... i was too fired up, go go go , to stop . ...........and ask questions ....

I believe the last code i put up works in that trivial example, except the line at the beginning

Range("B1:f8").ClearContents

should be :-

Range("B1:G8").ClearContents

which should clear the last column where i was stuffing the final outcome.

Applogies for the crack at the end of the last post , about 2 jt favs, 2 jt 2nd favs - just blowing off steam after a stretching session.

The idea of incrementing Rankings seems fairly crunchy - well - compared to my mega 2-D code. I just struggled to get my head around RANK

I blame PeteB for recently introducing me to SET , and FOR EACH ( which i ditched )

I am whittering on , as i am waiting for the next bug to manifest.....

thanks for assistance

Paul