Toggle Button Font Keeps Shrinking When Clicked

[Kinchen]

I am new to Excel VBA and this may seem like a silly question, but every time i click my toggle button the font shrinks to the point I can barely make out what it says. This is the code i've used for my toggle button. Any help is much appreciated

Private Sub ToggleButton1_Click()
If ToggleButton1 Then
Range("G1:R12").Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Range("G1:G12").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("G1:R1").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("B12").Select
ActiveWindow.Zoom = 80
Columns("G:R").Select
Columns("G:R").EntireColumn.AutoFit
Selection.ColumnWidth = 10
Range("E1").Select
Else
Columns("G:R").Select
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
End If
Sheets("Summary").Range("E1").Select
End Sub

 

[Datsmart]

Sometimes "selecting" cells will cause code to do undesired things when you repeat it in a macro. The macro recorder always builds your code this way.
Re-wrote your code without using Selection. Maybe the changed code will stop your button font changes. I couldn't get your code to effect my test button, maybe your button is located in a vulnerable spot in your sheet.

Private Sub ToggleButton1_Click()
    'Assign variables for later use
        rng1 = Range("G1:R12").Address
        rng2 = Range("G1:G12").Address
        rng3 = Columns("G:R").Address
    If ToggleButton1 Then
        'Change Rng1 Font
        With Range(rng1).Font
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
        End With
        'Remove any borders from Rng2
        With Range(rng2)
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            .Borders(xlEdgeBottom).LineStyle = xlNone
        End With
        'Put Right Edge Border on Rng2
        With Range(rng2).Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        'Remove any borders from Rng2
        With Range(rng2)
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
        End With
        'Put Bottom Edge Border on Rng2
        With Range(rng2).Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlThin
        End With
        'Remove any Right Edge borders from Rng2
        With Range(rng2)
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
        ActiveWindow.Zoom = 80
        Columns("G:R").EntireColumn.AutoFit
        Columns("G:R").ColumnWidth = 10
    Else
        'Change Rng3 Font
        With Columns(rng3).Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
        End With
        'Remove any borders from Rng3
        With Columns(rng3)
            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone
            .Borders(xlEdgeLeft).LineStyle = xlNone
            .Borders(xlEdgeTop).LineStyle = xlNone
            .Borders(xlEdgeBottom).LineStyle = xlNone
            .Borders(xlEdgeRight).LineStyle = xlNone
            .Borders(xlInsideVertical).LineStyle = xlNone
            .Borders(xlInsideHorizontal).LineStyle = xlNone
        End With
    End If
End Sub

 

[Kinchen]

Thank you so much John The font finally stays the same with each click and the macro still works perfectly after adjusting the ranges. I appreciate the help!


Cory