Ranking system depending on 2 variables

[niklasbp]

Hi there

I'm not sure if this is even possible but i will try and describe it and see if you have someway to do it

i'm working with 3 columns, sales , score and rank

i want the rank column to count from 1 to max, but is has to depend on the other to columns in this way:

if row 1 has the highest score, and has sales above 300 the rank on this would be 1 but if the sales are below 300 the code has to move on to the second highest score and see if sales are above 300 and then rank this 1. when all the ranks are giving to the scores that has a matching sales that are above 300. The rest has to get rank from the highest to lowest and it has to continue in the same column

example:


sales
score
rank


100
194
3


400
134
1


200
122
4


700
99
2



I hope you can help

/The VBA newb

[ashleyuk1984]

I was able to replicate your rank results with the following code

Sub SCORE()


Dim LastRow As Integer
Dim Rank As Integer
Dim x As Integer


LastRow = Range("B" & Rows.Count).End(xlUp).Row
Rank = 1


For x = 3 To LastRow
If Range("A" & x).Value > 300 Then
Range("C" & x).Value = Rank
Rank = Rank + 1
End If
Next x


For x = 3 To LastRow
If Range("C" & x).Value = "" Then
Range("C" & x).Value = Rank
Rank = Rank + 1
End If
Next x


End Sub

[p45cal]

a way which doesn't depend on the sales or the score being sorted:
Sub blah()
'works on the active sheet.
Dim results()
LastRow = Range("B" & Rows.Count).End(xlUp).Row
Set rngScores = Range("C2:C" & LastRow) 'assumes your data starts in row 2
denom = Application.WorksheetFunction.Max(rngScores.Offset(, -1)) + 1
rngScores.FormulaR1C1 = "=IF(RC[-2]>=300,RC[-1],RC[-1]/" & denom & ")"
y = rngScores.Value
ReDim results(1 To UBound(y), 1 To 1)
For i = 1 To UBound(y)
results(i, 1) = Application.WorksheetFunction.Rank(y(i, 1), rngScores)
Next i
rngScores.Value = results
End Sub

it works by first putting temporary formulae in the rank column (which divides the score by 1 more then the highest score if the sales are less than 300, otherwise leaves the score as is), then it works out the rank of each of those values and puts them in an array which then overwrites the temporary formulae in one hit.

[niklasbp]

Thx it works great, but i have one challenge with it

I cant seem to move the offset to range correct

my actual sheet looks like this:




Name
Sales
TP
PPO
total
Total Index
rank


lol
101
176
104
140
140
?




How do i rewrite it so that sales are at B, score is F and rank is G?

sry i know that its probably super easy but i have now tried for more than an hour :P

[ashleyuk1984]

I'm not sure who you're reffering the question to, myself or p45cal.
But nevertheless, I'll adjust my code to fit your requirements.



Sub SCORE()
Dim LastRow As Integer
Dim Rank As Integer
Dim x As Integer

LastRow = Range("A" & Rows.Count).End(xlUp).Row
Rank = 1

For x = 2 To LastRow
If Range("B" & x).Value > 300 Then
Range("G" & x).Value = Rank
Rank = Rank + 1
End If
Next x

For x = 2 To LastRow
If Range("G" & x).Value = "" Then
Range("G" & x).Value = Rank
Rank = Rank + 1
End If
Next x

End Sub

[p45cal]

Sub blah()
'works on the active sheet.
Dim results()
LastRow = Range("B" & Rows.Count).End(xlUp).Row 'is column B guaranteed to always have something in it right to the bottom? If not choose another column to determine last row.
Set rngscores = Range("G2:G" & LastRow) 'assumes your data starts in row 2
denom = Application.WorksheetFunction.Max(rngscores.Offset(, -1)) + 1
rngscores.FormulaR1C1 = "=IF(RC[-5]>=300,RC[-1],RC[-1]/" & denom & ")"
y = rngscores.Value
ReDim results(1 To UBound(y), 1 To 1)
For i = 1 To UBound(y)
results(i, 1) = Application.WorksheetFunction.Rank(y(i, 1), rngscores)
Next i
rngscores.Value = results
End Sub

[snb]

I'd prefer (based on post #1):


Sub M_snb()
sn = Cells(1).CurrentRegion.Resize(, 3)

For j = 1 To UBound(sn)
sn(j, 3) = 300 * Abs(sn(j, 1) > 300) + sn(j, 2)
Next

Cells(1).CurrentRegion.Resize(, 3) = sn

Columns(3).SpecialCells(2).Name = "snb_002"
[snb_002] = [index(rank(snb_002,snb_002),)]
End Sub

Based on your new requirements (and it's not 'super easy' !)


Sub M_snb()
sn = Cells(1).CurrentRegion.Resize(, 7)
ReDim sp(UBound(sn), 0)

For j = 2 To UBound(sn)
sp(j - 2, 0) = 300 * Abs(sn(j, 2) > 300) + sn(j, 6)
Next

Cells(2, 7).Resize(UBound(sp) - 1).Name = "snb_002"
[snb_002] = sp
[snb_002] = [index(rank(snb_002,snb_002),)]
End Sub