i've written a procedure to where it selects the first and second highest values not already selected (as designated by previous highlights of green and yellow). The first highest ignores anything already highlighted in green or yellow and selects the highest value. The second highest value ignores anything highlighted in green or yellow AND ignores the first highest highlighted in red. It then designates each selection with a 1 for 1st highest and 2 for second highest. It works but the problem is... it takes 1 minute 30 seconds to run, which isn't ideal. Is there another way I can write this? Please see below and thank you.Sub Macro1()' Select highest value not already selected (as designated by highlights green and yellow)Sheets(sheet1).SelectDim rng As Range, s As RangeSet rng = Range(C2:D500000)Set s = Range(C2)For Each r In rngIf r.Value > s And r.EntireRow.Interior.ColorIndex <> 4 And r.EntireRow.Interior.ColorIndex <> 6 Then Set s = rNext rFor Each r In rngIf s.Value = r.Value And r.EntireRow.Interior.ColorIndex <> 4 And r.EntireRow.Interior.ColorIndex <> 6 Then r.EntireRow.Interior.ColorIndex = 22Next r' Select second highest value not already selected (as designated by highlights green, yellow, and red, which is first highest)Dim rng2 As Range, q As RangeSet rng2 = Range(C2:D500000)Set q = Range(C2)For Each r In rng2If r.Value > q And r.EntireRow.Interior.ColorIndex <> 22 And r.EntireRow.Interior.ColorIndex <> 4 And r.EntireRow.Interior.ColorIndex <> 6 Then Set q = rNext rFor Each r In rng2If q.Value = r.Value And r.EntireRow.Interior.ColorIndex <> 22 And r.EntireRow.Interior.ColorIndex <> 4 And r.EntireRow.Interior.ColorIndex <> 6 _Then r.EntireRow.Interior.ColorIndex = 20Next r'Designates 1st highest with the number 1Dim rg As RangeSet rg = Range(V2:V500000)For Each cell In rgIf cell.EntireRow.Interior.ColorIndex = 22 Thencell.Offset(0, 1) = 1End IfNext'Designates second highest with the number 2Set rg3 = Range(V2:V500000)For Each cell In rg3If cell.EntireRow.Interior.ColorIndex = 20 Thencell.Offset(0, 1) = 2End IfNextEnd Sub
Select highest and second highest values
vba;excel