VBA easy way to code all toggle buttons

[Jason Sawyer]

Learning on my own, forgive stupidity please.

I have a spreadsheet with 100 toggle buttons that when true/false will show/hide the comments of a cell.

Private Sub ToggleButton1_Click()
Range(ToggleButton1.LinkedCell).Select
If ToggleButton1.Value = True Then
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveCell.Comment.Visible = True
ElseIf ToggleButton1.Value = False Then
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveCell.Comment.Visible = False
End If
End Sub

This works great. I would like to have the commands generic so that I can point all of the buttons to point to a ?macro? so I do not have to rename each ToggleButton#.

Private Sub ToggleButton1_Click()
Module1.ToggleCommand
End Sub
Private Sub ToggleButton2_Click()
Module1.ToggleCommand
End Sub

Sub ToggleCommand()
Range(ToggleButton.LinkedCell).Select
If ToggleButton.Value = True Then
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveCell.Comment.Visible = True
ElseIf ToggleButton.Value = False Then
ActiveCell.Offset(0, 2).Range("A1").Select
ActiveCell.Comment.Visible = False
End If
End Sub

But this does not work. Am I just an idiot or can something like this be accomplished, or both? What I have so far, is pieced together from what I figured out playing with VBA and searching the web.

Thanks,
Jason

 

[Andrew Poulsom]

Your code could be shortened to:

Private Sub ToggleButton1_Click()
    With ToggleButton1
        Range(.LinkedCell).Offset(0, 2).Comment.Visible = .Value
    End With
End Sub

That way the name of the ToggleButton appears only once. You could pass the ToggleButton as an object to another procedure, but you would still have to change the name for each button.

 

[RoryA]

Try:

Private Sub ToggleButton1_Click()
   ToggleCommand ToggleButton1
End Sub
Private Sub ToggleButton2_Click()
   ToggleCommand ToggleButton2
End Sub
Private Sub ToggleButton3_Click()
   ToggleCommand ToggleButton3
End Sub
Sub ToggleCommand(btn As MSForms.ToggleButton)
   With ActiveSheet
      .Range(btn.LinkedCell).Offset(0, 2).Comment.Visible = btn.Value
   End With
End Sub

You could also use a class module, if that fits your definition of easy!

 

[Andrew Poulsom]

Example of a class module:

'Class module named ToggleClass
 
Public WithEvents ToggleGroup As MSForms.ToggleButton
 
Private Sub ToggleGroup_Click()
    With ToggleGroup
        Range(.LinkedCell).Offset(0, 2).Comment.Visible = .Value
    End With
End Sub
 
'ThisWorkbook module
 
Dim TBs() As New ToggleClass
 
Private Sub Workbook_Open()
    Dim TBCount As Integer
    Dim Ctrl As OLEObject
    TBCount = 0
    For Each Ctrl In Worksheets("Sheet1").OLEObjects
        If TypeName(Ctrl.Object) = "ToggleButton" Then
                TBCount = TBCount + 1
                ReDim Preserve TBs(1 To TBCount)
                Set TBs(TBCount).ToggleGroup = Ctrl.Object
        End If
    Next Ctrl
End Sub

After entering the code save, close and reopen the workbook and try it out by clicking a ToggleButton.

 

[erik.van.geit]

Hi,

only passing by quicky so someone will need to finish this
I'm stuck on the classmodule code: see comment

advantages:
you need to code only once, even if the number of buttons changes
no code per button

create classmodule and accept defualt name "Class1"

Option Explicit
 
Public WithEvents GroupToggleButton As MSForms.ToggleButton
Private Sub GroupToggleButton_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    With GroupToggleButton
        'next line needs to be corrected
        'Range(.LinkedCell).Offset(0, 2).Comment.Visible = .Value
    End With
End Sub

in a normal module

Option Explicit
Dim ToggleButtonHandler() As New Class1
Private Sub Auto_Open()
Dim I
Dim SH As Worksheet
Dim CB As Object
I = 0
Set SH = Sheets("sheet1")
    For Each CB In SH.OLEObjects
        If TypeName(CB.Object) = "ToggleButton" Then
        I = I + 1
        ReDim Preserve ToggleButtonHandler(1 To I)
        Set ToggleButtonHandler(I).GroupToggleButton = CB.Object
        End If
    Next CB
End Sub

kind regards,
Erik

 

[Jason Sawyer]

Thank you all so much. I have been beating my head on a wall trying to figure this out. It works great.

Jason

 

[KurtisT]

I know this is a old post, but I had a similar situation and I was able to adapt this. Thank you.