To determine the font of a cell and change it if required

[Subodh]

I need to have a sub
The sub checks range A1 to A10
and determine the font of the cell
IF the font is not Times new roman
it makes the font to times new roman
and the font size to 10
also, if the font is not installed in the system
it should give a message.
ANy tips will be appreciated
Thanks in advance.

 

[Subodh]

I need to have a sub
The sub checks range A1 to A10
and determine the font of the cell
IF the font is not Times new roman
it makes the font to times new roman
and the font size to 10
also, if the font is not installed in the system
it should give a message.
ANy tips will be appreciated
Thanks in advance.

I tried the follwing
Sub mysub()
x = ActiveCell.Font.Name
If x <> "Mercantile" Then
MsgBox "Not Mercantile Font."
With Selection.Font
.Name = "Mercantile"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
'With Selection.Font
' .Name = "Mercantile"
' .Size = 11

End If
'End If
End Sub

Function mysubs(argname As Variant) As Variant
mysubs = argname * 2
If Application.Caller.Address = ActiveCell.Address Then Call mysub
End Function

But, it didn't work.