script to replace 3 fonts in multiple Excel SS's.

[rossetmj]

Our company has been using 3 fonts company wide for years that were owned by our parent company. Now that we have been sold we must discontinue the use of those fonts in all existing and future Office files. I've created a template in Word to remove these fonts but I am not sure about how to go about it in Excel. The three fonts that need removed are: "Tech Sans Black" "Tech Sans Medium" and "Tech Sans Book" and I can replace these with the Arial font. Any suggestions and help will be appreciated. I will be providing users with a macro that they can run against any spreadsheets that contain these fonts.

[martindwilson]

simple macro to change font to arial in all sheets is

Sub changefont()
Worksheets.Select
    With Selection.Font
        .Name = "Arial"
        .Size = 10 'change to size you want or leave out
         End With
End Sub

[rossetmj]

Thanks for the response. One more question. These are for the most part large multi font spreadsheets. I only want to replace the fonts for the 3 fonts "Tech Sans Book" "Tech Sans Black" and "Tech Sans Medium" How do I specify replacing only those three fonts in the macro?

[BigBas]

Martin was on the right track. You just need to include a few if statements to query for specific font types.

The code below is a sample that can be modified. It changes any ARIAL fonts to Times New Roman

Sub Change_Fonts()
    Dim cel As Range
    Dim rng As Range
    
    Set rng = ActiveSheet.UsedRange
    With Application
        .ScreenUpdating = False
        
    For Each cel In rng
        If cel.Font.Name = "Arial" Then
            cel.Font.Name = "Times New Roman"
        End If
    Next cel
    
        .ScreenUpdating = True
    End With
    
End Sub

[martindwilson]

ok i took bigbas's code had a think and reworked it thus

Sub Change_Fonts()
Application.ScreenUpdating = False
    Dim cel As Range
    Dim rng As Range
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
  
         
    Set rng = ws.UsedRange
   For Each cel In rng
    Select Case True
    Case cel.Font.Name = "Times New Roman CE"
            cel.Font.Name = "Arial"
    Case cel.Font.Name = "Times New Roman Greek"
            cel.Font.Name = "Arial"
    Case cel.Font.Name = "Times New Roman TUR"
            cel.Font.Name = "Arial"
    
     End Select
    Next cel
  Next ws
    Application.ScreenUpdating = True
End Sub

change font names to suit
i think this works ok i tested it and it works for me