Delete checkbox from a Specific Cell with VBA-CodePudding

I'm putting together a spreadsheet that should populate checkboxes in a specific column when the spreadsheet opens if the appropriate A Column/Row is not empty. It should also remove checkboxes when it finds that same A column to be empty. My VB is correctly creating the checkboxes, but I cannot figure out how to tell the code to delete the checkbox from a specific cell.

Most articles I find mention removed ALL checkboxes, but I'm looking to do it conditionally. Any guidance would be greatly appreciated.

    Private Sub Workbook_Open()
'declare a variable
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")
    'calculate if a cell is not blank across a range of cells with a For Loop
    For x = 2 To 1000
        If ws.Cells(x, 1) <> "" Then
            Call Add_CheckBox(CInt(x))
        Else
            Call Delete_CheckBox(CInt(x))
        End If
    Next x

End Sub

Private Sub Add_CheckBox(Row As Integer)
    ActiveSheet.CheckBoxes.Add(Cells(Row, "T").Left, Cells(Row, "T").Top, 72, 12.75).Select
    
    With Selection
        .Caption = ""
        .Value = xlOff '
        .LinkedCell = "AA" & Row
        .Display3DShading = False
    End With
End Sub

Private Sub Delete_CheckBox(Row As Integer)
    Dim cb As CheckBox
    If cb.TopLeftCell.Address = (Row, "T") Then cb.Delete
    
End Sub

CodePudding user response：

Naming the CheckBoxes will make it easier to maintain your code.

Private Sub Workbook_Open()
    Const CheckBoxPrefix As String = "Sheet1TColumnCheckBox"
    'declare a variable
    Dim CheckBoxName As String
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")
    'calculate if a cell is not blank across a range of cells with a For Loop
    Dim r As Long
    For r = 2 To 1000
        CheckBoxName = CheckBoxPrefix & r
        If Len(ws.Cells(r, 1)) > 0 Then
            If Not WorksheetContainsCheckBox(CheckBoxName, ws) Then Add_CheckBox CheckBoxName, ws.Cells(r, 1), ws.Cells(r, "AA")
        Else
            If WorksheetContainsCheckBox(CheckBoxName, ws) Then ws.CheckBoxes(CheckBoxName).Delete
        End If
    Next

End Sub

Private Sub Add_CheckBox(CheckBoxName As String, Cell As Range, LinkedCell As Range)
    With Cell.Worksheet.CheckBoxes.Add(Cell.Left, Cell.Top, 72, 12.75)
        .Caption = ""
        .Value = xlOff '
        .LinkedCell = LinkedCell
        .Display3DShading = False
        .Name = CheckBoxName
    End With
End Sub

Function WorksheetContainsCheckBox(CheckBoxName As String, ws As Worksheet)
    Dim CheckBox As Object
    On Error Resume Next
        Set CheckBox = ws.CheckBoxes(CheckBoxName)
        WorksheetContainsCheckBox = Err.Number = 0
    On Error GoTo 0
End Function

CodePudding user response：

Try something like this (put a checkbox "in" A1 but not C1)

Sub tester()
    Debug.Print Delete_CheckBox([A1])
    Debug.Print Delete_CheckBox([C1])
End Sub

'Return True if able to delete a checkbox from range `rng`
 Private Function Delete_CheckBox(rng As Range) As Boolean
    Dim cb As CheckBox
    For Each cb In rng.Worksheet.CheckBoxes
        If Not Application.Intersect(cb.TopLeftCell, rng) Is Nothing Then
            Debug.Print "Deleting checkbox in " & cb.TopLeftCell.Address
            cb.Delete
            Delete_CheckBox = True
            Exit For
        End If
    Next cb
End Function