How to avoid writing 50 or more Subs

[underpressure]

I plan to add 50 CheckBoxes to a ws in my project.

Other than creating 50 Subs to handle these events, can I get suggestions on how to:

Sub CheckBox3_Click()
Application.ScreenUpdating = False
If CheckBox3.Value = True Then
Range([COLOR=#ff0000]"B3:V3"[/COLOR]).Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.5
    End With
Else
Range([COLOR=#ff0000]"B3:V3"[/COLOR]).Select
    With Selection.Font
        .Color = vbRed
        .Bold = True
   
    End With
  End If
End Sub
_______________________________________________________________ 
Sub CheckBox4_Click()
Application.ScreenUpdating = False
If CheckBox4.Value = True Then
Range([COLOR=#ff0000]"B4:V4"[/COLOR]).Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.5
    End With
Else
Range([COLOR=#ff0000]"B4:V4"[/COLOR]).Select
    With Selection.Font
        .Color = vbRed
        .Bold = True
   
    End With
  End If
End Sub

 

[Fluff]

Rather than having a load of checkboxes, why not use a doubleclick event

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Not Intersect(Target, Range("A:A")) Is Nothing Then
      Cancel = True
      If Target.Offset(, 1).Font.Color = vbRed Then
         With Target.Offset(, 1).Resize(, 21).Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.5
         End With
      Else
         With Target.Offset(, 1).Resize(, 21).Font
            .Color = vbRed
            .Bold = True
         End With
      End If
   End If
End Sub

This works on doubleclicking in col A

 

[njimack]

[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]Sub CheckBox1_Click()[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]Dim row As Long[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]row = Replace(ActiveSheet.Shapes(Application.Caller).Name,"Check Box", "")[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]With Range(Cells(row, 2), Cells(row, 22)).Font[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    [/COLOR][/SIZE][SIZE=3][COLOR=#000000].Color = vbRed[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]    [/COLOR][/SIZE][SIZE=3][COLOR=#000000].Bold = True[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]End With[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/CO[/COLOR][/SIZE][/FONT]DE]

 

[underpressure]

Fluff,
I like your suggestion and think it's a better solution.
Thanks....as usual, you've saved me from hours of frustration.

njimack,
I like your approach, too.
But, initial application results in a Run Time error
"The Item with the specified name wasn't found."
I'll look it over when I have more time, but for now I'll implement Fluff's solution.
Thanks for helping with this.
​

 

[njimack]

That error is probably because I used Checkbox1. Try changing the 1 to 3 and see if it works

 

[Fluff]

Fluff,
I like your suggestion and think it's a better solution.
Thanks....as usual, you've saved me from hours of frustration.
​

You're welcome & thanks for the feedback

 

[underpressure]

Sadly, I still get the same error at:
row = Replace(ActiveSheet.Shapes(Application.Caller).Name, "Check Box", "")

Unfortunately, further along in my project I have a CommandButton that will no longer function properly with Fluff's solution. One thing always leads to another!!!
This is intended to Print the unchecked Checkboxes. Hummmm.

Private Sub CommandButton3_Click()
Dim myrange As String
Dim lr As Long
Dim oneDriveFolder As String
Dim obCB As OLEObject, i As Integer
  
With ActiveSheet
   lr = .Range("A" & .Rows.Count).End(xlUp).row
   .Range("T" & lr).Value = " "
End With
  
For i = 3 To 50
    Set obCB = ThisWorkbook.ActiveSheet.OLEObjects("CheckBox" & i)
   
   With ActiveSheet
    If Cells(i, 3).Value = 0 Then
            obCB.Object = True
    End If
    End With
    If obCB.Object.Value = False Then
    
    With ActiveSheet.PageSetup
        .Zoom = 125
        .LeftMargin = Application.InchesToPoints(0)
        .TopMargin = Application.InchesToPoints(4)
        .Orientation = xlPortrait
        
        Range(Cells(i, 2), Cells(i, 3)).PrintOut
         
    End With
    End If
    
Next i
End Sub

 

[Fluff]

Try

   For i = 3 To 50
      With ActiveSheet
         If Cells(i, 2).Font.Color = vbRed Then
            With .PageSetup
               .Zoom = 125
               .LeftMargin = Application.InchesToPoints(0)
               .TopMargin = Application.InchesToPoints(4)
               .Orientation = xlPortrait
               Range(Cells(i, 2), Cells(i, 3)).PrintOut
            End With
         End If
      End With
   Next i

 

[underpressure]

Fluff,
So indebted to you. Thanks for that.
I was preparing to go thru 1,700 to 1,800 words to accomplish those results!
I'll raise my favorite IPA in your honor tonight!

 

[Fluff]

You're welcome & thanks for the feedback