Programmatically and Dynamically Adding/Deleting Checkboxes to Sheet

[rasinc]

I've been asked to generate a dynamic list of tasks dependent on selections from a form. Once the selections are made, the programming will generate a list that may be 5 rows or 15 rows long (or more or less). I've pieced together the following code to add checkboxes programmatically to my sheet in a specific range which works but I have some further criteria from the client. I'll make the range dynamic later.

1. Special Effect 3D
2. Checkbox linked to the cell it is currently occupying
3. If the last task list was 15 rows and the new one is 10 rows, the last 5 checkboxes should be deleted (this would be a different sub but all part of the programming needed

I know checkbox names increment numerically but I don't know how to identify which one was just added or how to determine which one's currently exist. I'm having a hard time understanding the MS info on shapes, so I thought I would try here to see if anyone has had this need before.

TIA, rasinc

    Dim rng As Range
    Dim cel As Range
    
    Set rng = Range("A15:A20")
    Dim cb As CheckBox
        
    For Each cel In rng
        With Sheets("Event")
           With .Shapes.AddFormControl(xlCheckBox, cel.left, cel.top - 1, 15, 15)
                .TextFrame.Characters.Text = ""
                [COLOR=rgb(209, 72, 65)]'cb.LinkedCell = cel.Address <<--link checkbox to cell it is in - error on identifying the checkbox cb.LinkedCell (Object variable or with block variabl not set)
                '   how do I identify the exact checkbox just added to assign a cell to it
                '<<-- set 3D special effect[[/COLOR]
            End With
        End With       
    Next cel

 

[John_w]

The Shape's .OLEFormat.Object property gives you the underlying CheckBox object, to which you can assign the 3D effect and linked cell.

Public Sub Add_Form_Checkboxes()

    Dim rng As Range
    Dim cel As Range
    Dim cbShape As Shape
    Dim cb As CheckBox
   
    Set rng = Worksheets("Event").Range("A15:A20")
       
    For Each cel In rng
        Set cbShape = cel.Worksheet.Shapes.AddFormControl(xlCheckBox, cel.Left, cel.Top - 1, 15, 15)
        With cbShape
            .TextFrame.Characters.Text = ""
            Set cb = .OLEFormat.Object
        End With
        cb.Display3DShading = True
        cb.LinkedCell = cel.Address
    Next cel
   
End Sub

 

[rasinc]

John

Thank you very much for your quick reply. I've tested your solution and it works well for the first and second parts of my client's list.

Would you have a hint for me to complete #3?

I've started building this sub based on your code above but am having a problem cycling through the list of shapes.

    Dim cbShapes As Shapes
    Dim cb As CheckBox
    Dim rng As Range
    Dim cel As Range
    
    Set rng = Worksheets("Event").Range("A15:A20")
    For Each cel In rng
        Set cb = cel.Worksheet.Shapes.Item()  '<<--this doesn't work, needs an index
        MsgBox (cb.Name)
        cb.Delete
    Next cel

 

[rasinc]

OK I think I have part of the solution for the deletion of checkboxes.
The following code appears to work but does select the Run button as well (this is the only other shape on the sheet). I've tested for it and it does not get deleted.

Is this the best way of accomplishing it or am I missing something that might come back to bite me in the future?

Dim cbShapes As Shapes
    Dim cbShape As Shape
    Dim sr As ShapeRange
    

    Worksheets("Event").Shapes.SelectAll
    Set sr = Selection.ShapeRange
    
    For Each cbShape In sr
        'MsgBox (cbShape.Name & " = " & cbShape.AlternativeText)
        If cbShape.AlternativeText <> "Run" Then
            cbShape.Delete
        End If
    Next cbShape

 

[John_w]

Looking at the shape's text like that is one way of doing it. Simplifying your code:

Public Sub Delete_All_Shapes_Except_Run_Shape()

    Dim shp As Shape
    
    For Each shp In Worksheets("Event").Shapes
        If shp.AlternativeText <> "Run" Then
            shp.Delete
        End If
    Next
    
End Sub

If the last task list was 15 rows and the new one is 10 rows, the last 5 checkboxes should be deleted (this would be a different sub but all part of the programming needed

Another way is to give each checkbox a specific, unique name (the Shape's Name property), for example the address of the cell it sits in, when you add the 15 checkboxes.

For example, if the 15 checkboxes are in A15:A29, you would add them like this to give them the names "cb_A15", "cb_A16", etc.

Public Sub Add_Form_Checkboxes()

    Dim rng As Range
    Dim cell As Range
    Dim cbShape As Shape
    Dim cb As CheckBox
   
    Set rng = Worksheets("Event").Range("A15:A29")
       
    For Each cell In rng
        Set cbShape = cel.Worksheet.Shapes.AddFormControl(xlCheckBox, cell.Left, cell.Top - 1, 15, 15)
        With cbShape
            .Name = "cb_" & cell.Address(False, False)
            .TextFrame.Characters.Text = ""
            Set cb = .OLEFormat.Object
        End With
        cb.Display3DShading = True
        cb.LinkedCell = cell.Address
    Next cel
   
End Sub

And then the procedure which deletes the last 5 checkboxes (in cells A25:A29) would be like this:

Public Sub Delete_Form_Checkboxes()

    Dim rng As Range
    Dim cell As Range
    Dim cbShape As Shape
    
    Set rng = Worksheets("Event").Range("A25:A29")
        
    For Each cell In rng
        Set cbShape = cell.Worksheet.Shapes("cb_" & cell.Address(False, False))
        cbShape.Delete
    Next
        
End Sub

 

[rasinc]

John

Thank you for the alternatives. I think at this point, I will stay with your simplified code and test for the single button. However, there is another project that I am starting that will include some charts on a page and is starting to look like I may need to have some static checkboxes that may need to be controlled programmatically to reset them all, etc. Your option to give each checkbox a name based on underlying cell looks really good. From the reading I have been doing, charts are also shapes and testing for all of them might make the code too bulky. It gives me and likely others some interesting options.

I really appreciate the time you took to provide the code. Thank you again.