Highlight top 4 Scores or Equal

[grady121]

I have list of scores in Column AK that I want to highlight in Red, the top for scores or equal.

I have the Conditional Format code below, but it only highlights the top 4 scores in total.

    Application.Goto Cells(Rows.Count, "AK").End(xlUp)
    Range(Selection, Range("AK10")).Select
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$AK10>=LARGE($AK$10:$AK$100,5)"
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .ColorIndex = 3
    End With

If the range list consists of scores:-

12
11
10
10
9
9
9
8
7
6
5

What I need is to highlight all the top 4 scores, or equal e.g. all 7 scores from 12 down to 9 inclusive.
Not just the top 4, which only goes down to 10.

Any help appreciated.

 

[sijpie]

The issue here is that LARGE() indeed counts the two 10s as seperate values.

You can add the following function to your sheet, whcih will calculate the correct value.

Option Explicit
Function Largest(rSel As Range, iNo As Integer) As Double
    Dim iCnt As Integer, i As Integer
    Dim dRes1 As Double, dRes2 As Double
    
    i = 1
    iCnt = 1
    dRes1 = Application.WorksheetFunction.Large(rSel, i)
    Do While iCnt < iNo
        Do
            i = i + 1
            dRes2 = Application.WorksheetFunction.Large(rSel, i)
        Loop While dRes2 = dRes1
        dRes1 = dRes2
        iCnt = iCnt + 1
     Loop
     Largest = dRes1
End Function

Now in your sheet you have a new function called 'Largest'
You use it just as LARGE, but it will give you the correct output

or you can refer to it in your own macro

 

[grady121]

Hi sijpie
Thanks for coming back.

At the moment the existing sub is being called from a CommandButton on the worksheet, just to test it works, but I would like to call it from within another Sub if possible after all the scores are entered.

Unfortunately nothing changes when the Function is simply added to the existing sheet. All I'm getting is a "Compile Error - Argument not optional" - highlighting "Largest". This is the same when either placed and 'called' for in the same worksheet. or when its placed in a seperate Module.

Can you see where I'm possibly going wrong?

Thanks.

 

[sijpie]

It would mean that you are using 'Largest' with wrong arguments.

If you call it from another function or sub then you need to use it as:

sub TestL()
 
   dim rMyRange as Range, iMax as Integer
 
' one way
   MsgBox Largest(Range("A1:A50"), 3)
 
'another way
   set rMyRange = Range("A1:A50")
   iMax = 4
 
   MsgBox Largest(rMyRange, iMax)
end Sub

So you need to pass it a Range object and the 'max' number

 

[grady121]

Hi sijpie,
Excuse my ignorance, I'm still learning VB.

I'm now getting the correct value for the 4th highest score, but don't know how to dimension/select all the top scoring cells and format them as per original requirement.

Can you help with the final piece of the jigsaw?

 

[sijpie]

in your original macro, you just need to replace LARGE with LARGEST

In a formula in a cell "A1:A20" means that Excel will pass the range to the function. So
=LARGEST(A1:A20,4)
is the same as

 MyVar = Largest(Range("A1:A20"),4)

I have rewritten your original code to make it more efficient, and if it is run from a button press for instance, it will put the cursor back in the current active cell. (If it is part of a larger macrto then you can delete those few lines, see comments in code)

Sub SetupCF()
    Dim lRow As Long
    Dim rCur As Range
    
    'store current selected cell to restore position when done
    Set rCur = Selection
    
    'go to top of range to be formatted
    Range("AK10").Select
    With ActiveCell
        lRow = .Row + .CurrentRegion.Rows.Count - 1
    End With
    With Range("AK10:AK" & lRow)
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$AK10>=LARGEST($AK$10:$AK$" & lRow & ",5)"
        With .FormatConditions(1).Font
            .Bold = True
            .Italic = False
            .ColorIndex = 3
        End With
    End With
    
    'restore position
    rCur.Select
    Set rCur = Nothing
End Sub

 

[grady121]

Hi sijpie,

Thanks very much for your time & help.

It works really well and is exactly what I needed.

This Forum comes up trumps again.