Creating a generic Checkbox_Click VBA Code - vba

Question

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.

Answer 1

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
Else
cbCell.Offset(0, 1).Value = vbNullString
End If
End Sub

Answer 2

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
Sheets("Sheet1").Columns("A:Z").ClearContents
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
Next
End Sub
Please update the below code in WorkShee Active
Private Sub Worksheet_Activate()
For Each chk In ActiveSheet.CheckBoxes
chk.OnAction = "ProcessAllCheckBox"
Next
ProcessAllCheckBox
End Sub