Как исправить мой код, чтобы показывался только один максимум? - VBA

Формулировка задачи:

Здравствуйте! Прошу помощи. Как исправить мой код ниже? Надо один максимум. Условия. Заполнить 3-й столбец 10 целыми числами. Выделить все четные положительные красным цветом и обвести рамкой, максимальный элемент увеличить в 10 раз и обвести рамкой.

Sub MaxJuneKarou()
Dim i%, k%, q%, Max&
Cells.Clear
ReDim a(1 To 10)
For i = 1 To 10
  a(i) = Int((30 * Rnd) - 15)
  Cells(i, 3) = a(i)
Next
 
k = 0
For i = 1 To 10
  If Cells(i, 3) > 0 And a(i) Mod 2 = 0 Then
  Cells(i, 3).Font.Color = vbRed
  Cells(i, 3).Borders.Weight = xlMedium
  k = k + 1
  End If
Next
 
Max = 10: q = 0
  For i = 1 To 10
    If Cells(i, 3) >= Max Then
    Max = Cells(i, 3)
    q = i
    Cells(q, 5) = 10 * Max
    Cells(q, 5).Font.Color = vbBlue
    Cells(q, 5).Borders.Weight = xlMedium
    End If
   Next
  
End Sub

Решение задачи: «Как исправить мой код, чтобы показывался только один максимум?»

textual
                            Листинг программы 
                        

                            With [c1:c10].Find(WorksheetFunction.Max(a))
  .Offset(, 2).Value = .Value * 10
  .Offset(, 2).Font.Color = vbBlue
  .Offset(, 2).Borders.Weight = xlMedium
End With
                        