'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
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 |
