Hi all,

I have a Score column that runs into many entries.

Is there a way to highlight the top 5 scores on the list in different
colours.

Conditional format permits me to highlight the three largest only (yes
another gripe on this much needed excel feature!)

Any help is appreciated in advance!!

Regards
Manosh

Does this help?

Sub highlightlargest()
lr = Cells(Rows.Count, "e").End(xlUp).Row
rng = Range("e2:e" & lr)
With Columns(5)
..Interior.ColorIndex = 0
..Find(Application.Large(rng, 1)).Interior.ColorIndex = 4
..Find(Application.Large(rng, 2)).Interior.ColorIndex = 5
'etc
End With
End Sub


--
Don Guillett
SalesAid Software

wrote in message
oups.com...
Hi all,

I have a Score column that runs into many entries.

Is there a way to highlight the top 5 scores on the list in different
colours.

Conditional format permits me to highlight the three largest only (yes
another gripe on this much needed excel feature!)

Any help is appreciated in advance!!

Regards
Manosh

Say your data goes from A1 thru A100

Set the conditional format for A1 to be:

Formula Is
=(A1LARGE(A$1:A$100,6))
with a hi-lighted format
and copy the format down the column

The top 5 items will be hi-lighted
--
Gary's Student


" wrote:

Hi all,

I have a Score column that runs into many entries.

Is there a way to highlight the top 5 scores on the list in different
colours.

Conditional format permits me to highlight the three largest only (yes
another gripe on this much needed excel feature!)

Any help is appreciated in advance!!

Regards
Manosh

different colours.


--
Don Guillett
SalesAid Software

"Gary''s Student" wrote in message
...
Say your data goes from A1 thru A100

Set the conditional format for A1 to be:

Formula Is
=(A1LARGE(A$1:A$100,6))
with a hi-lighted format
and copy the format down the column

The top 5 items will be hi-lighted
--
Gary's Student


" wrote:

Hi all,

I have a Score column that runs into many entries.

Is there a way to highlight the top 5 scores on the list in different
colours.

Conditional format permits me to highlight the three largest only (yes
another gripe on this much needed excel feature!)

Any help is appreciated in advance!!

Regards
Manosh

Thanks for your reply Don

Apologies for the duplicate posting.

i understand how the code may be extended for n etc numbers to be
highlighted different colours.

However, where do i enter this code? is it in the view code area of the
worksheet?

regards
manosh

Manosh, the code that Don provided need to go in a module not in the sheet
code

To put in this macro, from your workbook right-click the workbook's icon and
pick View Code. This icon is to the left of the "File" menu this will open
the VBA editor, in Project Explorer click on your workbook name, if you
don't see it press CTRL + r to open the Project Explorer, then go to insert,
module, and paste the code in the window that opens on the right hand side,
press Alt and Q to close this window and go back to your workbook and press
alt and F8, this will bring up a box to pick the Macro from, click on the
Macro name to run it. If you are using excel 2000 or newer you may have to
change the macro security settings to get the macro to run. To change the
security settings go to tools, macro, security, security level and set it to
medium


--
Paul B
Always backup your data before trying something new
Please post any response to the newsgroups so others can benefit from it
Feedback on answers is always appreciated!
Using Excel 2002 & 2003

wrote in message
ups.com...
Thanks for your reply Don

Apologies for the duplicate posting.

i understand how the code may be extended for n etc numbers to be
highlighted different colours.

However, where do i enter this code? is it in the view code area of the
worksheet?

regards
manosh

Thanks Paul

This works great when you run the macro.

However, the beauty of the conditional format was that it was 'live'

How can this code be run automatically to reflect anychanges to the
sheet automatically?

Regards
M

Hi Manosh,

This will make it 'live'. I used it in the worksheet module and it works
fine.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Integer
Dim rng As Range

lr = Cells(Rows.Count, "e").End(xlUp).Row
Set rng = Range("e2:e" & lr)
With Columns(5)
..Interior.ColorIndex = 0
..Find(Application.Large(rng, 1)).Interior.ColorIndex = 4
..Find(Application.Large(rng, 2)).Interior.ColorIndex = 5
'etc
End With
End Sub

HTH
Regards,
Howard

wrote in message
oups.com...
Hi all,

I have a Score column that runs into many entries.

Is there a way to highlight the top 5 scores on the list in different
colours.

Conditional format permits me to highlight the three largest only (yes
another gripe on this much needed excel feature!)

Any help is appreciated in advance!!

Regards
Manosh

This has an error checker.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Integer
Dim rng As Range

lr = Cells(Rows.Count, "e").End(xlUp).Row
Set rng = Range("e2:e" & lr)
On Error GoTo nope

With Columns(5)
..Interior.ColorIndex = 0
..Find(Application.Large(rng, 1)).Interior.ColorIndex = 4
..Find(Application.Large(rng, 2)).Interior.ColorIndex = 5
'etc
End With

nope:
End Sub


wrote in message
oups.com...
Hi all,

I have a Score column that runs into many entries.

Is there a way to highlight the top 5 scores on the list in different
colours.

Conditional format permits me to highlight the three largest only (yes
another gripe on this much needed excel feature!)

Any help is appreciated in advance!!

Regards
Manosh

Once again thanks Howard for the prompt reply on this forum.

On using this i have found that when there are two equal values (or
same rank) the formula only highlights the first occurance. Can this be
corrected?

To easier computing!
M

Hi Howard

Thanks again for your help

This error checker still highlights only the first occurance. It should
highlight ALL occurances of the same rank. Is this possible in excel?

m

Hmmm, I'll give it some thought. Hopefully, Don G. is still monitoring this
thread, I'm sure he can whip one out in a sec.

Regards,
Howard

wrote in message
oups.com...
Hi all,

I have a Score column that runs into many entries.

Is there a way to highlight the top 5 scores on the list in different
colours.

Conditional format permits me to highlight the three largest only (yes
another gripe on this much needed excel feature!)

Any help is appreciated in advance!!

Regards
Manosh

Thanks Howard.

Conditional format takes care of this quite easily on the fly.

Another reason for MS to support upto 10 conditional formats(! :)

Look fwd to your workaround.

regards
m

Here's an attempt to catch ties. The colors are inconsistent when there are
multiple ties. So, if it is important that the rank and color are always
the same, then this won't work for you. It does seem to always color the 5
highest.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Integer
Dim lr As Integer
Dim rng As Range
Dim Cell As Range

lr = Cells(Rows.Count, "e").End(xlUp).Row
Set rng = Range("e2:e" & lr)
rng.Interior.ColorIndex = 0

For Each Cell In rng

If Cell.Value = Application.Large(rng, 1) Then

Cell.Interior.ColorIndex = 5 ' dark blue
End If

If Cell.Value = Application.Large(rng, 2) Then
Cell.Interior.ColorIndex = 4 ' green
End If

If Cell.Value = Application.Large(rng, 3) Then
Cell.Interior.ColorIndex = 6 ' yellow
End If

If Cell.Value = Application.Large(rng, 4) Then
Cell.Interior.ColorIndex = 7 'viloet
End If

If Cell.Value = Application.Large(rng, 5) Then
Cell.Interior.ColorIndex = 8 'light blue
End If

Next

End Sub

Regards,
Howard

wrote in message
oups.com...
Hi all,

I have a Score column that runs into many entries.

Is there a way to highlight the top 5 scores on the list in different
colours.

Conditional format permits me to highlight the three largest only (yes
another gripe on this much needed excel feature!)

Any help is appreciated in advance!!

Regards
Manosh

This is turning out to be an interesting exercise :-)

Now there is a Run Time Error '13 Type Mismatch when there are no
numbers and i start to enter them one by one.

For example, if the code is already in the sheet, and the numbers start
to be put in the cell the error box pops up when Enter is pressed on
the first cell with a new number (all the other cells in the range are
currently blank).

Ideally this error should not appear... and yet the code should be
'live'. This would be most useful for novice user like us!

I am running out of thank yous!

regards
manosh

I see.

Sorry, that's my best shot at it. I'm sure the answer is not all that
complicated, but it's off my screen.

If you get a solution would you please send me a copy.


Regards,
Howard

wrote in message
oups.com...
Hi all,

I have a Score column that runs into many entries.

Is there a way to highlight the top 5 scores on the list in different
colours.

Conditional format permits me to highlight the three largest only (yes
another gripe on this much needed excel feature!)

Any help is appreciated in advance!!

Regards
Manosh

A slight mod to the code supplied by L. Howard Kittle to remove errors,
and to allow for the last (few) figures being deleted.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Integer
Dim lr As Integer
Dim rng As Range
Dim Cell As Range

lr = Cells(Rows.Count, "e").End(xlUp).Row
Set rng = Range("e2:e" & lr + 200)
rng.Interior.ColorIndex = 0 ' clear beyond last

Set rng = Range("e2:e" & lr)

For Each Cell In rng
On Error Resume Next

If Cell.Value = Application.Large(rng, 1) Then

Cell.Interior.ColorIndex = 5 ' dark blue
Else

If Cell.Value = Application.Large(rng, 2) Then
Cell.Interior.ColorIndex = 4 ' green
Else

If Cell.Value = Application.Large(rng, 3) Then
Cell.Interior.ColorIndex = 6 ' yellow
Else

If Cell.Value = Application.Large(rng, 4) Then
Cell.Interior.ColorIndex = 7 'viloet
Else

If Cell.Value = Application.Large(rng, 5) Then
Cell.Interior.ColorIndex = 8 'light blue
Else
End If
End If
End If
End If
End If

NextCell:
On Error GoTo 0

Next

End Sub


Hope this helps

--


Wrote:
This is turning out to be an interesting exercise :-)

Now there is a Run Time Error '13 Type Mismatch when there are no
numbers and i start to enter them one by one.

For example, if the code is already in the sheet, and the numbers
start
to be put in the cell the error box pops up when Enter is pressed on
the first cell with a new number (all the other cells in the range are
currently blank).

Ideally this error should not appear... and yet the code should be
'live'. This would be most useful for novice user like us!

I am running out of thank yous!

regards
manosh


--
Bryan Hessey
------------------------------------------------------------------------
Bryan Hessey's Profile: http://www.excelforum.com/member.php...o&userid=21059
View this thread: http://www.excelforum.com/showthread...hreadid=533133

I have just read your post on Blank cells, and if you intend to have
blank cells and less than 5 (high) figures then you would need to add
code to accomodate this, the lines to be added a

-For Each Cell In rng
On Error Resume Next-

*If Cell.Value = "" Then

Else*-
If Cell.Value = Application.Large(rng, 1) Then-

add the bold lines where shown, and add another 'End If' to the
collection.

If needed the full code is attached at:


http://www.excelforum.com/attachment...8&d=1145179806

==

Bryan Hessey Wrote:
A slight mod to the code supplied by L. Howard Kittle to remove errors,
and to allow for the last (few) figures being deleted.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Integer
Dim lr As Integer
Dim rng As Range
Dim Cell As Range

lr = Cells(Rows.Count, "e").End(xlUp).Row
Set rng = Range("e2:e" & lr + 200)
rng.Interior.ColorIndex = 0 ' clear beyond last

Set rng = Range("e2:e" & lr)

For Each Cell In rng
On Error Resume Next

If Cell.Value = Application.Large(rng, 1) Then

Cell.Interior.ColorIndex = 5 ' dark blue
Else

If Cell.Value = Application.Large(rng, 2) Then
Cell.Interior.ColorIndex = 4 ' green
Else

If Cell.Value = Application.Large(rng, 3) Then
Cell.Interior.ColorIndex = 6 ' yellow
Else

If Cell.Value = Application.Large(rng, 4) Then
Cell.Interior.ColorIndex = 7 'viloet
Else

If Cell.Value = Application.Large(rng, 5) Then
Cell.Interior.ColorIndex = 8 'light blue
Else
End If
End If
End If
End If
End If

NextCell:
On Error GoTo 0

Next

End Sub


Hope this helps

--


+-------------------------------------------------------------------+
|Filename: Code.txt |
|Download: http://www.excelforum.com/attachment.php?postid=4638 |
+-------------------------------------------------------------------+

--
Bryan Hessey
------------------------------------------------------------------------
Bryan Hessey's Profile: http://www.excelforum.com/member.php...o&userid=21059
View this thread: http://www.excelforum.com/showthread...hreadid=533133

If you want the first 5 UNIQUE largest numbers then try this:

Sub b()
Dim Cell As Range

lr = Cells(Rows.Count, "e").End(xlUp).Row
Set rng = Range("e2:e" & lr + 200)
rng.Interior.ColorIndex = 0 ' clear beyond last

Set rng = Range("e2:e" & lr)
i = 1
For j = 1 To 5
With rng
Set c = .Find(Application.Large(rng, i), LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
n = Application.CountIf(rng, Application.Large(rng, i))
Do
c.Interior.ColorIndex = j + 3
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
i = i + n
Next j
End Sub

" wrote:

Hi all,

I have a Score column that runs into many entries.

Is there a way to highlight the top 5 scores on the list in different
colours.

Conditional format permits me to highlight the three largest only (yes
another gripe on this much needed excel feature!)

Any help is appreciated in advance!!

Regards
Manosh

I create a helper column and use that in the findnext
It works but could probably be better.
Assumes data in col E and helper col in col L (could be hidden)

Sub HiglightLargestFiveUnique() 'with helper column
Cells(1, "l").Value = Application.Max(Range("e2:e500"))
For i = 2 To 5
Cells(i, "l").FormulaArray = _
"=max(if(e2:e500<l" & i - 1 & ",e2:e500))"
Next i

Columns(5).Interior.ColorIndex = 0
On Error Resume Next
ci = 33
For Each cel In Range("l1:l5")
With Range("e2:e" & Cells(Rows.Count, "e").End(xlUp).Row)
Set c = .Find(cel, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = ci
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
ci = ci + 1
Next cel
End Sub


--
Don Guillett
SalesAid Software

wrote in message
oups.com...
Hi all,

I have a Score column that runs into many entries.

Is there a way to highlight the top 5 scores on the list in different
colours.

Conditional format permits me to highlight the three largest only (yes
another gripe on this much needed excel feature!)

Any help is appreciated in advance!!

Regards
Manosh

All!

My sincere thanks to you who contributed to this exercise!

I am using the code and it seems robust and works well for my purpose!

Cheers!
Manosh

Which code?

--
Don Guillett
SalesAid Software

wrote in message
ups.com...
All!

My sincere thanks to you who contributed to this exercise!

I am using the code and it seems robust and works well for my purpose!

Cheers!
Manosh

Manosh,

It is good to see that the code works for you, and thank you for your
response

--

Wrote:
All!

My sincere thanks to you who contributed to this exercise!

I am using the code and it seems robust and works well for my purpose!

Cheers!
Manosh


--
Bryan Hessey
------------------------------------------------------------------------
Bryan Hessey's Profile: http://www.excelforum.com/member.php...o&userid=21059
View this thread: http://www.excelforum.com/showthread...hreadid=533133

Did you fully test this?

--
Don Guillett
SalesAid Software

"Bryan Hessey"
wrote in message
news:Bryan.Hessey.26cnum_1145178601.7032@excelforu m-nospam.com...

A slight mod to the code supplied by L. Howard Kittle to remove errors,
and to allow for the last (few) figures being deleted.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Integer
Dim lr As Integer
Dim rng As Range
Dim Cell As Range

lr = Cells(Rows.Count, "e").End(xlUp).Row
Set rng = Range("e2:e" & lr + 200)
rng.Interior.ColorIndex = 0 ' clear beyond last

Set rng = Range("e2:e" & lr)

For Each Cell In rng
On Error Resume Next

If Cell.Value = Application.Large(rng, 1) Then

Cell.Interior.ColorIndex = 5 ' dark blue
Else

If Cell.Value = Application.Large(rng, 2) Then
Cell.Interior.ColorIndex = 4 ' green
Else

If Cell.Value = Application.Large(rng, 3) Then
Cell.Interior.ColorIndex = 6 ' yellow
Else

If Cell.Value = Application.Large(rng, 4) Then
Cell.Interior.ColorIndex = 7 'viloet
Else

If Cell.Value = Application.Large(rng, 5) Then
Cell.Interior.ColorIndex = 8 'light blue
Else
End If
End If
End If
End If
End If

NextCell:
On Error GoTo 0

Next

End Sub


Hope this helps

--


Wrote:
This is turning out to be an interesting exercise :-)

Now there is a Run Time Error '13 Type Mismatch when there are no
numbers and i start to enter them one by one.

For example, if the code is already in the sheet, and the numbers
start
to be put in the cell the error box pops up when Enter is pressed on
the first cell with a new number (all the other cells in the range are
currently blank).

Ideally this error should not appear... and yet the code should be
'live'. This would be most useful for novice user like us!

I am running out of thank yous!

regards
manosh


--
Bryan Hessey
------------------------------------------------------------------------
Bryan Hessey's Profile:
http://www.excelforum.com/member.php...o&userid=21059
View this thread: http://www.excelforum.com/showthread...hreadid=533133

Change my code to. See below for an easy way to make automatic
Sub HiglightLargestFiveUnique() 'with helper columnn
Cells(1, "l").Value = Application.Max(Range("e2:e72"))
For i = 2 To 5
Cells(i, "l").FormulaArray = _
"=max(if(e2:e72<l" & i - 1 & ",e2:e72))"
Next i

Columns(5).Interior.ColorIndex = 0
On Error Resume Next
ci = 37
For Each cel In Range("l1:l5")
With Range("e2:e" & Cells(Rows.Count, "e").End(xlUp).Row) 'rng
Set c = .Find(cel, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = ci
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
ci = ci + 1
Next cel
End Sub

To autorun the macro on a change in col E (5)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 5 Then HiglightLargestFiveUnique
End Sub

--
Don Guillett
SalesAid Software

"Don Guillett" wrote in message
...
I create a helper column and use that in the findnext
It works but could probably be better.
Assumes data in col E and helper col in col L (could be hidden)

Sub HiglightLargestFiveUnique() 'with helper column
Cells(1, "l").Value = Application.Max(Range("e2:e500"))
For i = 2 To 5
Cells(i, "l").FormulaArray = _
"=max(if(e2:e500<l" & i - 1 & ",e2:e500))"
Next i

Columns(5).Interior.ColorIndex = 0
On Error Resume Next
ci = 33
For Each cel In Range("l1:l5")
With Range("e2:e" & Cells(Rows.Count, "e").End(xlUp).Row)
Set c = .Find(cel, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = ci
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address < firstAddress
End If
End With
ci = ci + 1
Next cel
End Sub


--
Don Guillett
SalesAid Software

wrote in message
oups.com...
Hi all,

I have a Score column that runs into many entries.

Is there a way to highlight the top 5 scores on the list in different
colours.

Conditional format permits me to highlight the three largest only (yes
another gripe on this much needed excel feature!)

Any help is appreciated in advance!!

Regards
Manosh