# highlighting top10% and bottom 10% from a row of numbers

#### Subu

##### New Member
Hi

I have product by customer (product x customer) spread sheet where I need to identify the top 10% items and bottom 10% items (by values) and give them some colour. A sample array is given below in line on this query. A sample spread sheet with the same data is uploaded to bit.ly/1Ts5AZk

The actual spread sheet has 1000s of lines and so a VBA is kindly requested to shade the top and bottom 10%s

I'm using Excel 2010 on a win 2000 machine. I have tried to search Mr Excel, but couldn't find a proper VBA... so even pointers to the right thread would be most appreciated. Any help would be most appreciated.

Sample :

 Product customer Kilos \$ / KG comments comments product 1 customer 1 10 KG 2.00 => bottom 10% (out of 10 cases) in av. sale price => say colour red product 1 customer 2 20 KG 2.10 No colour product 1 customer 3 30 KG 2.70 No colour product 1 customer 4 50 KG 3.10 No colour product 1 customer 5 60 KG 4.00 No colour product 1 customer 6 60 KG 2.50 No colour product 1 customer 7 70 KG 8.00 => top 10% (out of 10 cases) in Av. Sale price => colour Green product 1 customer 8 80 KG 8.00 - do - => colour Green product 1 customer 9 90 KG 3.00 No colour product 1 customer 10 100 KG 5.00 No colour product 2 customer 1 100KG 13.10 No colour product 2 customer 2 200KG 12.10 No colour product 2 customer 3 300KG 12.70 No colour product 2 customer 4 500KG 12.00 => bottom 10% (out of 10 cases) in av. sale price => colour red product 2 customer 5 600KG 14.00 No colour product 2 customer 6 600KG 12.50 No colour product 2 customer 7 705KG 18.00 => top 10% (out of 10 cases) in Av. Sale price => colour Green product 2 customer 8 801KG 18.00 - do - => colour Green product 2 customer 9 904KG 13.00 No colour product 2 customer 10 185KG 15.00 No colour

<tbody>
</tbody>

...and so on ....

Thanks and regards

Subu

### Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Try this:-
Code:
``````[COLOR="Navy"]Sub[/COLOR] MG18Feb11
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, Pc [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] Lg [COLOR="Navy"]As[/COLOR] Double, Sm [COLOR="Navy"]As[/COLOR] Double, R [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A3"), Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng.Areas
Pc = Dn.Count * 0.1
Lg = Application.Large(Dn.Offset(, 3).Value, Pc)
Sm = Application.Small(Dn.Offset(, 3), Pc)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] Dn
[COLOR="Navy"]If[/COLOR] R.Offset(, 3) = Sm [COLOR="Navy"]Then[/COLOR] R.Offset(, 3).Interior.Color = vbRed
[COLOR="Navy"]If[/COLOR] R.Offset(, 3) = Lg [COLOR="Navy"]Then[/COLOR] R.Offset(, 3).Interior.Color = vbGreen
[COLOR="Navy"]Next[/COLOR] R
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]``````
Regards Mick

Boss Mick G you are awesome !

Your VBA works like a charm on the original sample

My bad, I made a mistake on the first / original sample ... the sample has blank lines between each product, the real one does not have blank lines / breaks between products

Now, I tried the VBA as is on the sheet without line breaks, of course the "range" is not expected to work, and does not work

So could you pl modify your VBA for a situation / sp sheet where everything is the same as the first sp sheet, except that there are NO blank lines between products

Another sample is enclosed at bit.ly/1KujZBF

This sample is VBA enabled XL with your VBA in it

PS : Yes, some addl columns & rows can be found on this sample, those rows / columns I assume this can be handled by changing the start of range from A3 to K6 or whatever, However IF that thinking is flawed please correct that as well !!

thanks again
best regards
subu

Try this:-
NB:- The 10% margin was calculated by Taking the min Sale price from Max sale price for each product, then finding the 10% and then
Adding/ subtracting fro Max/ min Value.
Code:
``````[COLOR="Navy"]Sub[/COLOR] MG19Feb20
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant, R [COLOR="Navy"]As[/COLOR] Double, Sm [COLOR="Navy"]As[/COLOR] Double, Lg [COLOR="Navy"]As[/COLOR] Double, G [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("C6"), Range("C" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
Dic.Add Dn.Value, Array(Dn, Dn.Offset(, 8).Value, Dn.Offset(, 8).Value)
[COLOR="Navy"]Else[/COLOR]
Q = Dic(Dn.Value)
[COLOR="Navy"]If[/COLOR] Dn.Offset(, 8).Value < Q(1) [COLOR="Navy"]Then[/COLOR] Q(1) = Dn.Offset(, 8).Value
[COLOR="Navy"]If[/COLOR] Dn.Offset(, 8).Value > Q(2) [COLOR="Navy"]Then[/COLOR] Q(2) = Dn.Offset(, 8).Value
[COLOR="Navy"]Set[/COLOR] Q(0) = Union(Q(0), Dn)
Dic(Dn.Value) = Q
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.keys
R = Dic(K)(2) - Dic(K)(1)
Sm = 0.1 * R + Dic(K)(1)
Lg = Dic(K)(2) - 0.1 * R
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] G [COLOR="Navy"]In[/COLOR] Dic(K)(0)
[COLOR="Navy"]If[/COLOR] G.Offset(, 8).Value <= Sm [COLOR="Navy"]Then[/COLOR] G.Offset(, 8).Interior.Color = vbRed
[COLOR="Navy"]If[/COLOR] G.Offset(, 8).Value >= Lg [COLOR="Navy"]Then[/COLOR] G.Offset(, 8).Interior.Color = vbGreen
[COLOR="Navy"]Next[/COLOR] G
[COLOR="Navy"]Next[/COLOR] K
MsgBox "Run"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]``````
Regards Mick

You are a Genius ! This one works like a charm and yes you got the logic right !!

thanks a TON Mick

Really appreciate you taking time & effort to solve this

Best regards
Subu

You're very welcome

Replies
4
Views
250
Replies
4
Views
558
Replies
4
Views
1K
Replies
1
Views
376
Replies
1
Views
521

1,221,495
Messages
6,160,144
Members
451,625
Latest member
Rick127

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back