fill cell color for values found to be lower than the highest two in one column

[Danny54]

is there a way using vba to scan a column of values and fill the cell with color if a cell found is lower than two higher in the list?
in the following list 9503 and 9502 are considered to be the highest two, therefore any cell found lower that those numbers will be
colored in (filled). In this case all the 9501 interior cells color could be yellow


9501
9501
9502
9503
9501
9503
9502

Thanks

 

[DanteAmor]

Try this:

Change "C" to the column where you have the values in this line

Range("C2", Range("C" & Rows.Count).End(xlUp))

Sub color_values()
  Dim Max1 As Variant, Max2 As Variant, r As Range, c As Range
  Set r = Range("C2", Range("C" & Rows.Count).End(xlUp))
  Max1 = WorksheetFunction.Max(r)
  Max2 = Evaluate("=MAX(IF(" & r.Address & "<>" & Max1 & "," & r.Address & "))")
  
  For Each c In r
    If c.Value <> Max1 And c.Value <> Max2 Then c.Interior.Color = vbYellow
  Next
End Sub

 

[Marcelo Branco]

You can use Conditional Formatting
Example

Book1
	A
1	Numbers
2	9501
3	9501
4	9502
5	9503
6	9501
7	9503
8	9502
9
10	9500
Plan1

Insert this formula in CF
=AND(ISNUMBER(A2),LARGE(IF(FREQUENCY(IF(ISNUMBER(A$2:A$10),MATCH(A$2:A$10,A$2:A$10,0)),ROW(A$2:A$10)-ROW(A$2)+1),A$2:A$10),2)>A2)
Format button
Fill --> yellow

M.

 

[Danny54]

Sweet.

Thanks so much

DanteArmor
can this same code be applied to the display of a filtered sheet? (Visible Cells Only)

 

[DanteAmor]

can this same code be applied to the display of a filtered sheet? (Visible Cells Only)

Try this

Sub color_values()
  Dim Max1 As Variant, Max2 As Variant, r As Range, c As Range
  Set r = Range("C2", Range("C" & Rows.Count).End(xlUp))
  Max1 = WorksheetFunction.Max(r)
  Max2 = Evaluate("=MAX(IF(" & r.Address & "<>" & Max1 & "," & r.Address & "))")
  
  For Each c In r
    If c.Value <> Max1 And c.Value <> Max2 And c.EntireRow.Hidden = False Then c.Interior.Color = vbYellow
  Next
End Sub

 

[Danny54]

I didnt even think of looking for the EntireRow.Hidden. Sweet...

Do I need to add a Max3 line of code to move down and keep on more set of values? Its marking from the second set of values down.
shouldnt fill the 9506 and the 9504 entries.

Thanks

 

[DanteAmor]

I was not considering that a maximum value could be hidden. The following only works with visible values:

Sub color_values()
  Dim Max1 As Variant, Max2 As Variant, r As Range, c As Range
  Set r = Range("C2", Range("C" & Rows.Count).End(xlUp))
  Max1 = 0
  Max2 = 0
  
  For Each c In r.SpecialCells(xlCellTypeVisible)
    If c.Value > Max1 Then Max1 = c.Value
  Next
  For Each c In r.SpecialCells(xlCellTypeVisible)
    If c.Value <> Max1 And c.Value > Max2 Then Max2 = c.Value
  Next
  For Each c In r.SpecialCells(xlCellTypeVisible)
    If c.Value <> Max1 And c.Value <> Max2 Then c.Interior.Color = vbYellow
  Next
End Sub

 

[Danny54]

Perfect.

Many Many Thanks Dante.

Have a wonderful day.


Marcelo,
a genuine thanks to you as well. I tried yours as well but got a #VALUE! error. Could it have been because I have blanks in those fields as well?

You have a wonderful day as well.

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.