Problem with working with fonts

[omidfarrahi]

Hi
I am working on a cell that some parts are of different fonts. when using replace, the part that I replace works properly and I can change the font. but previous changes in the same cell that i have changed their fonts automatically changes to calibri font.
Private Sub OptionButton2_Click()

' --------------------- Two person verification : --------------

Dim S, celltext As String
Dim location As Integer

Unload Insert_Picture_Selection


Dim DataObj As New MSForms.DataObject

DataObj.GetFromClipboard
S = DataObj.GetText




ActiveCell.Replace What:=S, Replacement:=" E " + S


location = InStr(ActiveCell.Value, S)



'ActiveCell.Characters(start:=location - 1, Length:=1).Text = " = "

'MsgBox ActiveCell.Characters(start:=location - 1, Length:=2).Text

ActiveCell.Characters(start:=location - 2, Length:=1).Font.Name = "Ms Outlook"
ActiveCell.Characters(start:=location - 2, Length:=1).Font.Color = vbBlue
ActiveCell.Characters(start:=location - 2, Length:=1).Font.FontStyle = "Bold"

End Sub