Using RANK on a range of data - need an exception

[BlondieC]

Hi, this is the last piece for a little tool I'm working on. I've used RANK for the data range but what I need is for any cell with 0.00 in Column E to remain with that cell content and not be ranked numerically and preferablyy be at the bottom of the data content.

Only cells >0.00 should be ranked highest to lowest based on the revenue dollar amount.

The idea is to have the ranking number displayed rather that the revenue dollar amount except where the revenue = 0.00. Currently the data is ranking the way it should and displays the way it should but the rows with 0.00 are also displaying a ranking number. Thank you

My code:

Sheets("SiteCopy").Select
    Range("E8:E" & Range("E7").End(xlDown).Offset(-1).Row).Name = "DataRank"
       
    With Range("DataRank").Offset(0, 1)
        .FormulaArray = "=RANK(DataRank,DataRank)"
    
End With

 

[Marcelo Branco]

A data sample along with expected results would be helpful.

M.

 

[BlondieC]

Initial state of raw data:

Site CC	Site Name	Business Name	Revenue
101874	Toronto	Business 10	$10,150.22
103918	Montreal	Business 12	$999.81
15741	Vancouver	Business 5	$419.75
104144	Hamilton	Business 8	$553.60
438812	Paris	Business 23	$2,355.00
105250	Victoria	Business 54	$2,590.10
104982	Peterborough	Business 98	$2,473.55
356409	Point Pelee	Business 8	$0.00
104236	Prince Albert	Business 4	$429.30
Revenue Total			$19,971.33

<tbody>
</tbody>

After ranking:

Site CC	Site Name	Business Name	Ranking
101874	Toronto	Business 10	1
105250	Victoria	Business 54	2
104982	Peterborough	Business 98	3
438812	Paris	Business 23	4
103918	Montreal	Business 12	5
104144	Hamilton	Business 8	6
104236	Prince Albert	Business 4	7
15741	Vancouver	Business 5	8
356409	Point Pelee	Business 8	9
Revenue Total			$19,971.33

<colgroup><col><col><col><col></colgroup><tbody>
</tbody>

Desired outcome:

Site CC	Site Name	Business Name	Ranking
101874	Toronto	Business 10	1
105250	Victoria	Business 54	2
104982	Peterborough	Business 98	3
438812	Paris	Business 23	4
103918	Montreal	Business 12	5
104144	Hamilton	Business 8	6
104236	Prince Albert	Business 4	7
15741	Vancouver	Business 5	8
356409	Point Pelee	Business 8	$0.00
Revenue Total			$19,971.33

<tbody>
</tbody>

 

[Marcelo Branco]

Do you really want to delete the column Revenue?

M.

 

[BlondieC]

In this case yes as this worksheet will then be created as a .pdf and can be distributed to the various businesses without disclosing the business revenues. Another worksheet in the workbook will retain the site revenue for the Regional Manager to have on hand - this being a pivot table from which I've essentially copied and pasted values only onto the SiteCopy worksheet using some additional code and tweaked a few things. It is the data on the SiteCopy worksheet that I am wanting to rank. The Regional Managers want to create a bit of a competitive environment by showing businesses within their territory how they are ranked.

I did at one time try using the following formula in the worksheet - placed in column F: =IF(E8=0, "0.00", RANK(E8, $E$8:$E$36, 0)). However, the end of the range will change with each Manager and I wasn't able to get it to copy down to the last cell based on that being the second last cell in Column E with revenue data - as the total revenue amount is not to be included.

 

[Marcelo Branco]

See if this example helps

Adjust sheet name, ranges, etc to suit your case

Before macro
Sheet1

	A​	B​	C​	D​
1​	Site CC​	Site Name​	Business Name​	Revenue​
2​	101874​	Toronto​	Business 10​	$10.150,22​
3​	103918​	Montreal​	Business 12​	$999,81​
4​	15741​	Vancouver​	Business 5​	$419,75​
5​	104144​	Hamilton​	Business 8​	$553,60​
6​	438812​	Paris​	Business 23​	$2.355,00​
7​	105250​	Victoria​	Business 54​	$2.590,10​
8​	104982​	Peterborough​	Business 98​	$2.473,55​
9​	356409​	Point Pelee​	Business 8​	$0,00​
10​	104236​	Prince Albert​	Business 4​	$429,30​
11​	Revenue Total​			$19.971,33​

<tbody>
</tbody>

Macro

Sub aTest()
    Dim lastRow As Long
    
    With Sheets("Sheet1")
        lastRow = .Cells(2, "B").End(xlDown).Row
        .Range("E1") = "Ranking"
        With Range("E2:E" & lastRow)
            .Formula = "=IF(D2=0,D2,RANK(D2,D$2:D$" & lastRow & "))"
            .Value = .Value
        End With
        With .Range("A1:E" & lastRow)
            .Sort key1:=.Range("D1"), order1:=xlDescending, Header:=xlYes
        End With
        .Range("E" & lastRow + 1) = .Range("D" & lastRow + 1)
        .Columns("D:D").Delete
        
        'Optional: formats last two cells
        .Range("D" & lastRow & ":D" & lastRow + 1).NumberFormat = "[$$-409]#,##0.00"
    End With
            
End Sub

After macro

	A​	B​	C​	D​
1​	Site CC​	Site Name​	Business Name​	Ranking​
2​	101874​	Toronto​	Business 10​	1​
3​	105250​	Victoria​	Business 54​	2​
4​	104982​	Peterborough​	Business 98​	3​
5​	438812​	Paris​	Business 23​	4​
6​	103918​	Montreal​	Business 12​	5​
7​	104144​	Hamilton​	Business 8​	6​
8​	104236​	Prince Albert​	Business 4​	7​
9​	15741​	Vancouver​	Business 5​	8​
10​	356409​	Point Pelee​	Business 8​	$0,00​
11​	Revenue Total​			$19.971,33​

<tbody>
</tbody>

Hope this helps

M.

 

[Marcelo Branco]

Small adjustment in code

try

Sub aTest()
    Dim lastRow As Long
    
    With Sheets("Sheet1")
        lastRow = .Cells(2, "B").End(xlDown).Row
        .Range("E1") = "Ranking"
        With Range("E2:E" & lastRow)
            .Formula = "=IF(D2=0,D2,RANK(D2,D$2:D$" & lastRow & "))"
            .Value = .Value
        End With
        .Range("A1:E" & lastRow).Sort key1:=.Range("D1"), order1:=xlDescending, Header:=xlYes
        .Range("E" & lastRow + 1) = .Range("D" & lastRow + 1)
        .Columns("D:D").Delete
        
        'Optional: formats last two cells
        .Range("D" & lastRow & ":D" & lastRow + 1).NumberFormat = "[$$-409]#,##0.00"
    End With
            
End Sub

M.

 

[BlondieC]

Absolutely beautiful! I adjusted the sheet name and columns and rows to reflect my worksheet and it's perfect. I stepped through it one line at a time and it's much cleaner and more efficient than what I had coded. Some of what you incorporated I had coded separately. It makes more sense to include it the way you did. And I like how you did the ranking and retaining that data. I always try throughout the year to look for opportunities to develop new tools or enhance my existing portfolio and often find it's great in my head but extends beyond my current knowledge. Lucky for me my desire to develop small tools like this and my curiosity lead me to the path of learning on a daily basis. Thank you for your help with this!

 

[Marcelo Branco]

You are welcome. Glad to help

M.

 

[BlondieC]

Everything was working as desired and then I was asked to make some changes to address some privacy concerns. I made the changes and now have one glitch. Prior to making the requested changes there would always be more than one line of data or business to be ranked so everything worked fine. Now in some cases there is only one line of data or one business. If it were me and there was only one line I wouldn't see any reason to do any ranking etc. However, I have 100+ end users and one of them is bound to click the button that sets the ranking etc in motion and then the code fails. The code failing results in the error message: Runtime error '1004' Application-defined or object-defined error.

Dim LastRow As Long    
    With Sheets("SiteCopy")
        LastRow = .Cells(8, "C").End(xlDown).Row
        .Range("E7") = "Ranking"
        With Range("F8:F" & LastRow)
            .Formula = "=IF(E8=0,E8,RANK(E8,E$8:E$" & LastRow & "))"     '*****Issue with this line: it ranks the one line of data 1 (which is correct) and then ranks the Revenue Total dollar amount directly below the business also as 1.  It also then results in a 0 being entered in all remaining cells in column F  
            .Value = .Value
        End With
        .Range("B7:F" & LastRow).Sort key1:=.Range("E7"), order1:=xlDescending, Header:=xlYes
        .Range("F" & LastRow + 1) = .Range("E" & LastRow + 1)     '*****The code fails here when there is only one line of data or one business
        .Columns("E:E").Delete
        
        'Optional: formats last two cells
        .Range("E" & lastRow & ":E" & lastRow).NumberFormat = "[$$-409]#,##0.00"
    End With