Simple Rank Macro

[alocke]

Hi,
Just a simple thing - If I want to Rank data in cells A1,A3,A5,A7 amongst one another and also cells A2,A4,A6,A8 too.

The code I'm doing is more complex than this, but if someone can tell me how to do this then I'll be sorted. I think.

Cheers,
Alex

 

[alocke]

[FONT=Courier][COLOR=#00007F]Sub[/COLOR] Move_Data()
    [COLOR=#00007F]Dim[/COLOR] ar [COLOR=#00007F]As[/COLOR] Range, Dest5 [COLOR=#00007F]As[/COLOR] Range, Dest6 [COLOR=#00007F]As[/COLOR] Range
    [COLOR=#00007F]Dim[/COLOR] lr [COLOR=#00007F]As[/COLOR] [COLOR=#00007F]Long[/COLOR], rws [COLOR=#00007F]As[/COLOR] [COLOR=#00007F]Long[/COLOR]
    
    [COLOR=#00007F]Const[/COLOR] SrcSht [COLOR=#00007F]As[/COLOR] [COLOR=#00007F]String[/COLOR] = "Rank" [COLOR=#007F00]'<-- Name of sheet with percentrank formulas[/COLOR]
    [COLOR=#00007F]Const[/COLOR] PRcol [COLOR=#00007F]As[/COLOR] [COLOR=#00007F]String[/COLOR] = "V" [COLOR=#007F00]'<-- PercentRank column[/COLOR]
    [COLOR=#00007F]Const[/COLOR] fr [COLOR=#00007F]As[/COLOR] [COLOR=#00007F]Long[/COLOR] = 8 [COLOR=#007F00]'<-- First row[/COLOR]
    
    [COLOR=#00007F]Set[/COLOR] Dest5 = Sheets("Sheet5").Cells(2, Columns.Count).End(xlToLeft)
    [COLOR=#00007F]Set[/COLOR] Dest6 = Sheets("Sheet6").Cells(2, Columns.Count).End(xlToLeft)
    [COLOR=#00007F]With[/COLOR] Sheets(SrcSht)
        lr = .Cells(Rows.Count, PRcol).End(xlUp).Row
        [COLOR=#00007F]For[/COLOR] [COLOR=#00007F]Each[/COLOR] ar [COLOR=#00007F]In[/COLOR] .Range(PRcol & fr).Resize(lr - fr + 1) _
                .SpecialCells(xlFormulas).Areas
            [COLOR=#00007F]With[/COLOR] ar
                rws = .Rows.Count
                [COLOR=#00007F]Select[/COLOR] [COLOR=#00007F]Case[/COLOR] Abs(.Cells(rws - 2, 1).Value - .Cells(rws, 1).Value)
                    [COLOR=#00007F]Case[/COLOR] [COLOR=#00007F]Is[/COLOR] > 0.15
                        [COLOR=#00007F]Set[/COLOR] Dest5 = Dest5.Offset(, 1)
                        Dest5.Resize(rws).Value = ar.Offset(, -1).Value
                        Dest5.Offset(-1).Value = _
                            ar.Cells(1, 1).Offset(-4, -21).Value
                    [COLOR=#00007F]Case[/COLOR] [COLOR=#00007F]Is[/COLOR] < 0.15
                        [COLOR=#00007F]Set[/COLOR] Dest6 = Dest6.Offset(, 1)
                        Dest6.Resize(rws).Value = ar.Offset(, -1).Value
                        Dest6.Offset(-1).Value = _
                            ar.Cells(1, 1).Offset(-4, -21).Value
                [COLOR=#00007F]End[/COLOR] [COLOR=#00007F]Select[/COLOR]
            [COLOR=#00007F]End[/COLOR] [COLOR=#00007F]With[/COLOR]
        [COLOR=#00007F]Next[/COLOR] ar
    [COLOR=#00007F]End[/COLOR] [COLOR=#00007F]With[/COLOR]
[COLOR=#00007F]End[/COLOR] [COLOR=#00007F]Sub[/COLOR][/FONT]

Sorry I wasn't very clear.
Say you need to satisfy two criteria, like;
- The one already present in the code.
- and additionally something like

Select Case [FONT=Courier].Cells(rws - 2, 1).Value
Case is > 0.75 
......
Case is < 0.25
.....
End Case
[/FONT]

 

[Peter_SSs]

If I have understood correctly you could use a structure like ..

If Condition1 And Condition2 Then

ElseIf Condition3 And Condition4 Then

ElseIf ...

However, you could use Select Case as below. Note, though, that if you have different types of conditions, as I have below, it may be that more than one 'Case' may be True.
For example, with my code below and those values for a, b and c, both the second and the third Case conditions are True.

If that is the situation, then you have to order your 'Case' statements carefully (just as you would with the If..Then..elseIf example above, or any Select Case really) because the code will stop checking the Case statements as soon as it finds one that is True.

Anyway try stepping through this code with varying values for a, b and c and see if that concept is any use to you.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> SelectCaseTest()<br>    <SPAN style="color:#00007F">Dim</SPAN> a <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, b <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, c <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, n <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    a = 2       <SPAN style="color:#007F00">'<- Try different values</SPAN><br>    b = 1       <SPAN style="color:#007F00">'<- Try different values</SPAN><br>    c = 19      <SPAN style="color:#007F00">'<- Try different values</SPAN><br>    <br>    <SPAN style="color:#00007F">Select</SPAN> <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">True</SPAN><br>        <SPAN style="color:#00007F">Case</SPAN> a < 5 And b > 5<br>            n = 1<br>            <br>        <SPAN style="color:#00007F">Case</SPAN> a < 4 And c >= 12<br>            n = 2<br>            <br>        <SPAN style="color:#00007F">Case</SPAN> (b - a) < 0 And c = 19<br>            n = 3<br>        <br>        <SPAN style="color:#00007F">Case</SPAN> <SPAN style="color:#00007F">Else</SPAN><br>            n = 4<br>    <br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Select</SPAN><br>    <br>    MsgBox "First condition met was " & n<br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[alocke]

Brilliant, and what if a,b and c were similar to what I did in my Macro.
So:
a= Cells(rws,1).value - Cells(rws -2, 1).Value
(How would I define an example like that, as a variable?)
Thanks

 

[Peter_SSs]

.. what if a,b and c were similar to what I did in my Macro.
So:
a= Cells(rws,1).value - Cells(rws -2, 1).Value
(How would I define an example like that, as a variable?)

Pretty much as you have just done, except you may need
Dim a as Single
since your values may not be whole numbers.

 

[alocke]

Ok so, I tried playing around with what you suggested but every piece of data is going into sheet5. Can you see what I've done wrong?

Sub Move_Data()
    Dim ar As Range, Dest5 As Range, Dest6 As Range
    Dim lr As Long, rws As Long
    Dim Case1 As Single, Case2 As Single
 
 
 
 
    Const SrcSht As String = "Sheet1" '<-- Name of sheet with percentrank formulas
    Const PRcol As String = "V" '<-- PercentRank column
    Const fr As Long = 8 '<-- First row
 
 
 
 
    Set Dest5 = Sheets("Sheet5").Cells(2, Columns.Count).End(xlToLeft)
    Set Dest6 = Sheets("Sheet6").Cells(2, Columns.Count).End(xlToLeft)
 
 
    With Sheets(SrcSht)
        lr = .Cells(Rows.Count, PRcol).End(xlUp).Row
        For Each ar In .Range(PRcol & fr).Resize(lr - fr + 1) _
                .SpecialCells(xlFormulas).Areas
            With ar
                rws = .Rows.Count
 
                    Case1 = Cells(rws, 1).Value - Cells(rws - 2, 1).Value
                    Case2 = Cells(rws - 2, 1).Value
 
                Select Case True
 
 
                    Case Case1 > (0.15) And Case2 >= 0.75
                        Set Dest5 = Dest5.Offset(, 1)
                        Dest5.Resize(rws).Value = ar.Value
                        Dest5.Offset(-1).Value = _
                            ar.Cells(1, 1).Offset(-7, -21).Value
 
 
 
                    Case Case1 < -(0.15) And Case2 <= 0.25
                        Set Dest6 = Dest6.Offset(, 1)
                        Dest6.Resize(rws).Value = ar.Value
                        Dest6.Offset(-1).Value = _
                            ar.Cells(1, 1).Offset(-7, -21).Value
 
 
                    End Select
            End With
        Next ar
    End With
End Sub

Thanks.

 

[Peter_SSs]

I haven't tested your code with or without this correction, but this will be the first thing to try. You have dropped a couple of dots while amending my code. Try these changes.

Case1 = .Cells(rws, 1).Value - .Cells(rws - 2, 1).Value
Case2 = .Cells(rws - 2, 1).Value

Sorry to keep harping on it but as far as I know you have not addressed the question I have asked at least twice before

.. what happens if the last value or the third last value is one of the null strings ("") because the corresponding cell in column U was blank or an error?

I ask, because if that happens (& I presume it will at some stage) then the code will fall over on the first line of the code above.

What would any of these expressions evaluate to?

"" - 0.6
0.3 - ""
"" - ""

If you have addresses this issue, or it is impossible, just say so and I will drop it.

 

[alocke]

I haven't tested your code with or without this correction, but this will be the first thing to try. You have dropped a couple of dots while amending my code. Try these changes.

Case1 = .Cells(rws, 1).Value - .Cells(rws - 2, 1).Value
Case2 = .Cells(rws - 2, 1).Value

Cheers, should've seen that

Sorry to keep harping on it but as far as I know you have not addressed the question I have asked at least twice before I ask, because if that happens (& I presume it will at some stage) then the code will fall over on the first line of the code above.

What would any of these expressions evaluate to?

"" - 0.6
0.3 - ""
"" - ""

If you have addresses this issue, or it is impossible, just say so and I will drop it.

Sorry I didn't address this sooner!
Looking through now, there are errors. But based on the whole structure of the formula I'm writing it shouldn't... or atleast I think it shouldn't.

I may end up having to delete these sets of data, but I need to check with everyone else before I do. In the meantime is there a way that these situations can be ignored?

If its takes a lot of time on your side don't worry about it, as its not completely necessary.
Cheers.

 

[alocke]

Peter,
sorry by these values are you also referring to values which were ignored from the 'U' column (so they appear blank in the U column), or just values listed as #NA?

 

[Peter_SSs]

by these values are you also referring to values which were ignored from the 'U' column (so they appear blank in the U column), or just values listed as #NA?

In post #46 we introduced a formula for column U to stop it showing as an error. The formula in column V is like this as far as I am aware
=IF(ISNUMBER(U8),PERCENTRANK((U8,U208,U408,U608,U808,U1008),U8),"")

The code you posted in post #55 looks at those formulas in column V.

So, here is a section at the bottom of my first 'section' (rows 8:43). I've just shown each formula in row 40, but that formula is copied down to row 43.

Excel Workbook
	U	V
40	16	1
41
42	60	1
43	6	0.5
44
45
Sheet1

The formula in U41 is returning "" (because there is an error in cell Q41). The consequence of this is another "" in cell V41. However, V41 is the third last cell in the range in question (V8:V43). The last value (V43) is 0.5. How do we do 0.5 - "" so that we can use your 'Select case' statements?

In the meantime is there a way that these situations can be ignored?

Do you mean V8:V43 would not be copied anyewhere? Or do you mean we would use a different value, say the fourth last value (remembering that it could be "" as well)?

 

[alocke]

In post #46 we introduced a formula for column U to stop it showing as an error. The formula in column V is like this as far as I am aware
=IF(ISNUMBER(U8),PERCENTRANK((U8,U208,U408,U608,U808,U1008),U8),"")

The code you posted in post #55 looks at those formulas in column V.

So, here is a section at the bottom of my first 'section' (rows 8:43). I've just shown each formula in row 40, but that formula is copied down to row 43.

Excel Workbook
	U	V
40	16	1
41
42	60	1
43	6	0.5
44
45
Sheet1

The formula in U41 is returning "" (because there is an error in cell Q41). The consequence of this is another "" in cell V41. However, V41 is the third last cell in the range in question (V8:V43). The last value (V43) is 0.5. How do we do 0.5 - "" so that we can use your 'Select case' statements?

I see. Well I've decided to go through my spreadsheet, find any with these particular errors (its uncommon as later dates are more likely to have data), and set particular values (both the bottom and third to last cells) to have a value of 0, So it won't match either case, and therefore wont appear in the destination sheets. This would work would, wouldn't it?

I mean, this is only short term - I'll see what others would prefer but in the meantime it should be ok. [I think 9 of the 362 datasets have this particular error].