Dim i%, fin As Integer
With ActiveCell
If IsNumeric(.Value) Then Exit Sub
fin = Len(.Value)
For i = Len(CStr(Val(.Value))) + 1 To fin
If IsNumeric(Mid(.Value, i, 1)) = True And Mid(.Value, i - 1, 1) <> " " Then _
.Characters(i, 1).Font.Subscript = True
Next
End With