Subscript Size

[ronjon65]

I have text in cells that have subscripts. But the default subscript size is too small compared (relative the normal size). So is there a way to target just the subscripts (entire sheet or selected range) and just adjust the size of them? I can do this manually, but picking them out is a real tedious process when you have many of them (and pray that you don't have to adjust size later).

[SamT]

I can do this manually,

Record a Macro, and show us what you get.

[ronjon65]

FYI, I saw this, but its only for PPT
http://www.pptfaq.com/FAQ00635_Make_...pts_larger.htm

Here is the macro, but I don't see that being very useful.

    ActiveCell.FormulaR1C1 = "regularsubscript"
    With ActiveCell.Characters(Start:=1, Length:=7).Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With ActiveCell.Characters(Start:=8, Length:=9).Font
        .Name = "Arial"
        .FontStyle = "Regular"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = True
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With

[SamT]

I don't see that being very useful.

It tells me what your Cells look like and it tells me how to set the subscript Font size.

Off the top of my head, not compiled, not tested

Sub SamT()
Dim YourRange as Range
Dim Cel As Range
Dim i as Long
Dim j As Long

Set  YourRange = ???

For each Cel in YourRange
For i = Len(cel) to 1 Step -1
'Check backwards to first non-Subscript
If Mid(Cell, i, 1).Font.Subscript = False then
If i = Len(Cel) then 'The last character is non-Subscript, check next cel
GoTo CelNext
Else 'The first non-subscript is not the last character
J = i + 1 'Start of Subscript
With Right(Cel, j).Font
.Size = 20
.Subscript = true
End with
End if

End If
Next i
CelNext:
Next Cel

[Paul_Hossler]

ASSUMING that you've already tagged subscripts with the Font Subscript attribute, this will go through the cells in the selection and make those characters' font size = 120% of the normal font size

Option Explicit
Sub BiggerSubscripts()
    Dim i As Long
    Dim rCell As Range
    
    For Each rCell In Selection.Cells
        With rCell
            If .HasFormula Then GoTo TryNext
            If .HasArray Then GoTo TryNext
            For i = 1 To Len(.Value)
                If .Characters(i, 1).Font.Subscript Then
                   .Characters(i, 1).Font.Size = 1.2 * ActiveWorkbook.Styles("Normal").Font.Size
                End If
            Next I
        End With
TryNext:
    Next
End Sub

[ronjon65]

Thanks guys. I tried the one from Paul first and it worked great I didn't try the one from SamT though since I already had success.