'Add checkbox without caption cell

I tried to find old posts related to this same issue but couldn't find a solution which would fit to my code.

I'm trying to add checkboxes to Excel sheet every time I add new row to sheet. Checkbox should be added when date is added to range A11:A80. However with my current code checkbox is added but caption is always added which I don't want.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A11:A80")) Is Nothing Then
Call checkbox
End If
End Sub


Sub checkbox()

    Dim wsTarget As Worksheet
    Dim oCheckBox As checkbox
    Dim r As Range
    Dim cell As Range
    
    Set wsTarget = ActiveSheet
    Set r = wsTarget.Range("A11:A80")
    
    With wsTarget
    For Each cell In r
        If Weekday(cell, vbMonday) > 5 Then

        Else
        If Not IsEmpty(cell.Value) Then
            .CheckBoxes.Add Left:=cell.Offset(0, 9).Left, Top:=cell.Offset(0, 9).Top, Width:=60, Height:=15
            
        End If
        End If
        Next cell
    End With

End Sub

enter image description here Another issue is that checkbox is not added when I modify cell in range A11:A80, it only works when I manually run the macro

All the help is much appreciated! Thank you in advance



Solution 1:[1]

(1) Setting the label is easy. All you have to do is to assign the created Checkbox to a variable and work with that:

cb As CheckBox
Set cb = .CheckBoxes.Add(Left:=cell.Offset(0, 9).Left, Top:=cell.Offset(0, 9).Top, Width:=60, Height:=15)
cb.Caption = ""

(2) I assume that your Worksheet_Change-event is in the wrong place, it needs to be in the Worksheet-Module. I see no other reason why it is not triggered

(3) If you call your checkbox-routine multiple times, it will created multiple checkboxes for every row. I would suggest that you set a name for every checkbox containing the row number and test before adding a new checkbox if it already exists.

Dim cbName As String, cb As CheckBox
cbName = "checkBox_" & cell.Address
                                
On Error Resume Next
Set cb = Nothing
Set cb = .CheckBoxes(cbName)
On Error GoTo 0

If cb Is Nothing Then
    Set cb = .CheckBoxes.Add(Left:=cell.Offset(0, 9).Left, Top:=cell.Offset(0, 9).Top, Width:=60, Height:=15)
    cb.Caption = ""
    cb.Name = cbName
End If

Solution 2:[2]

Use selection checkbox to modify properties.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A11:A80")) Is Nothing Then
        Call checkbox
    End If
End Sub


Sub checkbox()
    Dim wsTarget As Worksheet
    Dim oCheckBox As checkbox
    Dim r As Range
    Dim cell As Range
    
    Set wsTarget = ActiveSheet
    Set r = wsTarget.Range("A11:A80")
    
    With wsTarget
    For Each cell In r
        If Weekday(cell, vbMonday) > 5 Then

        Else
        If Not IsEmpty(cell.Value) Then
            ActiveSheet.CheckBoxes.Add(cell.Offset(0, 9).Left, cell.Offset(0, 9).Top, 60, 15).Select
            With Selection
                .Caption = "Test caption name"
                .Value = xlOn 'xlOff to default
            End With
            
        End If
        End If
        Next cell
    End With

End Sub

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 FunThomas
Solution 2 jradelmo