CODEWITHSUNDEEP
vbaexcelcheckboxspreadsheet
Max Hanft
Max Hanft

Reputation: 15

Creating a generic Checkbox_Click VBA Code

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.

Upvotes: 1

Views: 981

Answers (2)

user3734575
user3734575

Reputation:

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

Upvotes: 1

David Zemens
David Zemens

Reputation: 53623

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

Upvotes: 2

Related Questions