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

**BigBas** · 03-17-2009, 02:57 PM

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** · 03-17-2009, 10:24 PM

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