Revised: Strange Behavior with ActiveX Checkboxes

[chobe]

I am trying to create a shopping list with several columns, a column for product name, a column with checkboxes to indicate if item is to be fresh and another if item is frozen, etc.
I used the sub routine below to create the checkboxes in the "fresh" column which seems to works as designed, the checkboxes are enabled, caption is "", value is False, and LinkedCell shows the value.

I then run a second subroutine (haven't figured how to loop when things change) to insert checkboxes in frozen column with the exact same code except , I changed the objects to not enabled, changed the column for the value of LinkedCell. But when I run it, a number of things go wrong. First, checking box in Fresh column changes value in Frozen column. Second, captions are not blank, LinkedCell is blank, etc.

What am I doing wrong or is it Excel? Thanks in advance.

Note: Underlined and bolded only two values changed between two operations

Dim addr, cnt As Integer
Dim Rng As Range
Dim WorkRng As Range
Dim Ws As Worksheet
On Error Resume Next
xTitleId = ""
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Set Ws = Application.ActiveSheet
Application.ScreenUpdating = False
addr = 2
cnt = 1

For Each Rng In WorkRng

    With Ws.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
        Left:=Rng.Left, Top:=Rng.Top, Width:=Rng.Width, Height:=Rng.Height)
        .Select
        ActiveSheet.OLEObjects("CheckBox" & cnt).Object.Caption = ""
        ActiveSheet.OLEObjects("CheckBox" & cnt).LinkedCell = "Sheet1![U][B]$F[/B][/U]$" & addr '-changed to $E
        ActiveSheet.OLEObjects("CheckBox" & cnt).Object.Value = False
        ActiveCell("CheckBox" & cnt).Object.Enabled = [U][B]True [/B][/U]'-Changed to False
        addr = addr + 1
        cnt = cnt + 1
    End With

Next

WorkRng.ClearContents
WorkRng.Select
Application.ScreenUpdating = True

End Sub

 

[DanteAmor]

Try this

Sub Add_Checkboxes()
    Dim addr, cnt As Integer
    Dim Rng As Range
    Dim WorkRng As Range
    Dim Ws As Worksheet
    'On Error Resume Next
    xTitleId = ""
    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
    Set Ws = Application.ActiveSheet
    Application.ScreenUpdating = False
    addr = 2
    cnt = 1
    
    For Each Rng In WorkRng
        With Ws.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, _
            Left:=Rng.Left, Top:=Rng.Top, Width:=Rng.Width, Height:=Rng.Height)
            .Select
            Selection.Object.Caption = ""
            Selection.LinkedCell = "Sheet1!$I$" & addr
            Selection.Object.Value = False
            Selection.Object.Enabled = True '-Changed to False
            addr = addr + 1
            cnt = cnt + 1
        End With
    Next
    
    WorkRng.ClearContents
    WorkRng.Select
    Application.ScreenUpdating = True
End Sub

 

[chobe]

That seems to have done the trick! Thank you for the assist

 

[DanteAmor]

That seems to have done the trick! Thank you for the assist

I'm glad to help you. Thanks for the feedback.