Inserting additional activex checkboxes using vba

[Andrewstupendo]

Hello All,
I have a question. I would like to add check boxes (activex) under certain conditions. Let's say I have an active worksheet that I am using and I copy and paste additional rows of data into the worksheet. I would like the activex check box private sub worksheet macro to insert additional check boxes next to the new rows of data that I have added. The check boxes are in column K with a linked cell (false) one column offset - column L. I have inserted a sub (non-private) macro that works quite well when adding check boxes to ALL non-blank rows in column A, but it does not add check boxes in an incremental fashion.

here is the code for the non-private sub macro:

Sub AddCkBx()
    Dim Rws As Long, rng As Range, c As Range, CkBx As OLEObject

    Rws = Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = Range(Cells(23, 1), Cells(Rws, 1)).SpecialCells(xlCellTypeConstants, 23)
    Application.ScreenUpdating = 0

    For Each c In rng.Offset(, 10)

        With Sheet1.OLEObjects.Add(ClassType:="Forms.Checkbox.1", _
                                   Top:=c.Top, Left:=c.Left, _
                                   Height:=c.Height, Width:=c.Width)

            .Object.Caption = ""
            .LinkedCell = c.Offset(0, 1).Address
            .Object.Value = 0    'sets checkbox to false
        End With

    Next c
End Sub

Many thanks to davesexcel for this coding.

Is there any way that a private sub worksheet macro can add check boxes while the sheet is open and rows of data are being added in increments?
In other words, if range A136:A142 is not blank, but range L136:L142 IS blank, then fill in K136:K142 with checkboxes as described in the above code. Please see the inserted image of the spreadsheet below.

If this is not possible, I have another solution: Add checkboxes (and the attendant linked cells) to range K23:K300. And then, hide/unhide the check boxes if any cells in range A23:300 are blank/not blank.

I have inserted an image of the spreadsheet for your review.

Many thanks in advance.

Best,
Andrewstupendo

 

[Domenic]

Try the following code, which needs to be placed in the code module for your sheet (right-click your sheet tab, and select View Code)...

[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]

[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Worksheet_Change([COLOR=darkblue]ByVal[/COLOR] Target [COLOR=darkblue]As[/COLOR] Range)
    [COLOR=darkblue]If[/COLOR] Target.Cells.Count > 1 [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    [COLOR=darkblue]If[/COLOR] Target.Row = 1 [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    [COLOR=darkblue]If[/COLOR] Target.Column > 1 [COLOR=darkblue]Then[/COLOR] [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
    [COLOR=darkblue]If[/COLOR] Len(Target) > 0 [COLOR=darkblue]Then[/COLOR]
        [COLOR=darkblue]Dim[/COLOR] rLinkedCell [COLOR=darkblue]As[/COLOR] Range
        [COLOR=darkblue]Dim[/COLOR] Rw [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
        [COLOR=darkblue]Set[/COLOR] rLinkedCell = Cells(Target.Row, "L")
        [COLOR=darkblue]If[/COLOR] Len(rLinkedCell) = 0 [COLOR=darkblue]Then[/COLOR]
            Rw = Target.Row
            [COLOR=darkblue]With[/COLOR] Me.OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
                                    Top:=Target.Top, Left:=Cells(Rw, "K").Left, _
                                    Height:=Cells(Rw, "K").Height, Width:=Cells(Rw, "K").Width)
                .LinkedCell = rLinkedCell.Address
                [COLOR=darkblue]With[/COLOR] .Object
                    .Caption = ""
                    .Value = 0
                [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
End [COLOR=darkblue]Sub[/COLOR]

Hope this helps!