Home » excel » excel – Creating a generic Checkbox_Click VBA Code

excel – Creating a generic Checkbox_Click VBA Code

Posted by: admin May 14, 2020 Leave a comment


I am creating an excel file that is a checklist, currently i have 73 checkboxes in Column D, where in column E it will populate the name of the user based on the username in the options field.

Currently i Have code such as:

Sub CheckBox1_Click()
 If ActiveSheet.CheckBoxes("Check Box 1").Value = 1 Then
   Range("E3").Value = Application.UserName
   Else: Range("E3").Value = ""
 End If
End Sub
Sub CheckBox2_Click() 
If ActiveSheet.CheckBoxes("Check Box 2").Value = 1 Then
   Range("E4").Value = Application.UserName
   Else: Range("E4").Value = ""
 End If
End Sub

For each checkbox in column D. It does work but I need to now replicate Column D into Columns F,H,J,L for other days of the week and I am curious if there is a faster way to do this and a cleaner way to do this instead of having a long list.

How to&Answers:

Try something like this. You will have to format each checkbox and assign this macro to each of them, from the Format | Assign Macro option.

Sub Generic_ChkBox()
Dim cbName As String
Dim cbCell As Range
Dim printValue as String

cbName = Application.Caller

Set cbCell = ActiveSheet.CheckBoxes(cbName).TopLeftCell

Select Case cbCell.Column
    Case 4
        'prints the username in column E
        printValue = Application.UserName
    Case 6
        'prints "Something else" in column G
        printValue = "Something else"
    Case 8
        'prints "etc..." in column I, etc.
        printValue = "etc..."
    Case 10
        printValue = "etc..."
    Case 12
        printValue = "etc..."
End Select

If ActiveSheet.CheckBoxes(cbName).Value = 1 Then
    cbCell.Offset(0, 1).Value = printValue
    cbCell.Offset(0, 1).Value = vbNullString
End If

End Sub


I have assumed your are going to assign the username value to next cell of CheckBox.
For D4 is having checkbox then value will be E4.

Sub ProcessAllCheckBox()
 Dim ws As Worksheet, s As Shape
  Set ws = ActiveSheet
  For Each chk In ActiveSheet.CheckBoxes
   If chk.Value = 1 Then
     Set s = ws.Shapes(chk.Caption)
     Sheets("Sheet1").Range(Cells(s.TopLeftCell.Row, s.TopLeftCell.Column + 1),  Cells(s.TopLeftCell.Row, s.TopLeftCell.Column + 1)).Value = Application.UserName
  End If

End Sub

Please update the below code in WorkShee Active

Private Sub Worksheet_Activate()
For Each chk In ActiveSheet.CheckBoxes
  chk.OnAction = "ProcessAllCheckBox"
End Sub