[COLOR="DarkSlateGray"][B]Private Sub Worksheet_Change(ByVal Target As Range)
Dim oCel As Range, oDat(), x
If Not Intersect(Target, Columns(1)) Is Nothing Then
With Range(Cells(1, 1), Cells(WorksheetFunction.Max(Cells(Rows.Count, 1).End(xlUp).Row, Cells(Rows.Count, 3).End(xlUp).Row, Cells(Rows.Count, 6).End(xlUp).Row, Cells(Rows.Count, 7).End(xlUp).Row) - 2, 7)).Offset(3)
oDat = .Value
With .Resize(, 1)
For Each oCel In .Cells
oDat(oCel.Row - 3, 3) = WorksheetFunction.CountIf(Range(Cells(1, 1), oCel), oCel.Value)
oDat(oCel.Row - 3, 4) = WorksheetFunction.CountIf(.Cells, oCel.Value)
If oDat(oCel.Row - 3, 4) = 0 Then oDat(oCel.Row - 3, 3) = Empty: oDat(oCel.Row - 3, 4) = Empty
If Not IsEmpty(oCel) Then
If oDat(oCel.Row - 3, 3) = oDat(oCel.Row - 3, 4) Then oDat(oCel.Row - 3, 7) = 100 * oDat(oCel.Row - 3, 3) - oCel.Row Else oDat(oCel.Row - 3, 7) = 0
Else
oDat(oCel.Row - 3, 7) = ""
End If
Next
End With
Application.EnableEvents = False
.Value = oDat
Application.EnableEvents = True
oDat = .Value
With .Resize(, 1)
For Each oCel In .Cells
If Not IsEmpty(oCel) And oCel.Offset(0, 6).Value <> 0 Then
x = WorksheetFunction.Rank(oCel.Offset(0, 6).Value, .Offset(0, 6), 0)
If x < 11 Then oDat(oCel.Row - 3, 6) = x Else oDat(oCel.Row - 3, 6) = ""
Else
oDat(oCel.Row - 3, 6) = ""
End If
Next
End With
Application.EnableEvents = False
.Value = oDat
Application.EnableEvents = True
End With
End If
End Sub[/B][/COLOR]