Check list via VBA

Hi,

I have a check list in excel with more than 100+ rows. I have also added strike through once I click on the checkbox
my office pc doesn't have the new version of excel with insert-check box feature

so, I found out below vba code that can help... now the problem is this code works for single rectangle shape. and I have 102 rectangles...

my rectangles start from Rectangle 11 to 96 and my strikethrough range is from J4 to J89
and again from rectangle 97 to 102 and strike through range - J95 to J100

is there a shorter way to tweak this code in such a way that it changes the shape number along with the range of strike through? for each rectangle I have to change the range in 3 different lines as shown below (highlighted in purple). I am attaching sample workbook for easier reference.

I know that we have ActiveX check box option from developer tab... and I am currently using it... but it does not allow to increase the size of the small square and it won't allow to change background color either.... so I am trying this one out... Please can someone help!

Sub Rectangle11_Click()
With ActiveSheet.Shapes("Rectangle 11")
        With .TextFrame2.TextRange.Characters
            .Text = IIf(.Text = "a", "", "a")
            .Font.Name = "Webdings"
            .Font.Size = 12
             Range("J4").Value = (.Text = "a")
        End With
    End With
End Sub

Originally Posted by Kinjal Doshi

Is there another code that can help assign this to each rectangles?
my rectangle numbers are from Rectangle 11 to Rectangle 102

Use code:

Sub AssignMacro()
    Dim i As Long
    For i = 11 to 102
         ActiveSheet.Shapes("Rectangle " & i).OnAction = "Rectangle_Click"
    Next i
End Sub

Edit: The above macro reports an error because there is no "Rectangle 69". There is "Shape 57".

1. Code in Module1

Option Explicit

Sub check_click()
Dim shp As Shape
    Set shp = ActiveSheet.Shapes(Application.Caller)
    With shp.TextFrame2.TextRange.Characters
        .Text = IIf(.Text = "a", "", "a")
        .Font.Name = "Webdings"
        .Font.Size = 12
        shp.Parent.Range("J" & shp.TopLeftCell.Row).Value = (.Text = "a")
    End With
End Sub

Sub AssignMacro()
Dim i As Long, shp As Shape
    For Each shp In Worksheets("Sheet1").Shapes
        If shp.TopLeftCell.Column = 11 Then shp.OnAction = "check_click"         '    in case there are other shapes on the sheet
    Next shp
End Sub

2. Code in ThisWorkbook

Option Explicit

Private Sub Workbook_Open()
    AssignMacro        '    in case you add new rectangles to column K again
End Sub

3. Save file -> Close file -> reopen file