Macro for linking selected check boxs to a cell


I have a worksheet with 7200 checkboxes in 12 different colums. I know, its a lot of checkboxes! 

I started with 4 colums of check boxes and copies those colums and the corresponding colums of linked cells 2 times to make the 12 colums of checkboxes

I want to be able to link a colum of checkboxes to a specific cell in a the corresponding colum for each checkbox.

The conditional formatting also need to be fixed so the checked cell is colored.

I need a macro that will allow me to select a group of check boxes in a colum and assign a linked cell to each of those checkboxes in a specified colum,




The code below will reset the LinkedCell property of check box on the specified sheet. Install the code in a standard code module (none of the code sheets in a workbook by default - you have to add it to a virgin workbook, by default Module1). Please set the four constants at the top of the code to the appropriate values. Run the Sub AssignLinkedCell.

Option Explicit

Sub AssignLinkedCell()
    ' 07 Jun 2019

    ' enter equal number of CheckBoxColumns and LinkedCellColumns,
    ' their position in the string matching, comma-separated
    Const CheckBoxColumns As String = "L,M"
    Const LinkedCellColumns As String = "O,P"
    Const SheetName As String = "Sheet2"
    Const FirstCheckBoxRow As Long = 12

    Dim Ws As Worksheet
    Dim CBox() As Long
    Dim CLnk() As Long
    Dim Chk As Shape
    Dim Ole As Object
    Dim i As Integer
    Dim R As Long

    Set Ws = ActiveWorkbook.Worksheets(SheetName)
    CBox = ColumnsArray(CheckBoxColumns)
    CLnk = ColumnsArray(LinkedCellColumns)

    For Each Chk In Ws.Shapes
        Set Ole = Chk.OLEFormat.Object
        If TypeName(Ole) = "CheckBox" Then
            With Ole
                i = Application.Match(.TopLeftCell.Column, CBox, 0)
                .LinkedCell = Cells(.TopLeftCell.Row, CLnk(i - 1)).Address
            End With
        End If
    Next Chk
End Sub

Private Function ColumnsArray(Clms As String) As Long()
    ' 07 Jun 2019

    Dim Fun() As Long
    Dim Sp() As String
    Dim i As Integer

    Sp = Split(Clms, ",")
    ReDim Fun(UBound(Sp))
    For i = 0 To UBound(Sp)
        Fun(i) = Columns(Trim(Sp(i))).Column
    Next i
    ColumnsArray = Fun
End Function

Note that you can enter as many CheckBoxColumns as you wish. Checkboxes found in columns which aren't listed will not be reset. If there are fewer columns listed in the LinkedCellColumns string than in the CheckBoxColumns string a fatal error will occur.

As for your CF, note that you need not specify an absolute reference to the linked cell. In the attached workbook I selected all cells with checkboxes in column L and clicked to add a new rule. I then entered the formula =$O12=TRUE, making only the column absolute. Excel applied the reference offsets to each row automatically. 

Let me caution you that the code may not run on your Exam worksheet. Perhaps the copy I downloaded is corrupt but I believe it should be your original as well. I was unable to fix it. Therefore I tested the code on a second sheet which I prepared especially. The first sheet in the attached workbook is also corrupt. I suspect that there are duplicate text boxes in identical locations - a result of incomplete deletions. However, the reason could also be that you established so many CF rules, one for each cell. There might be confusion somewhere due to the copying you did.

Frankly, I don't believe you will ever get your workbook to work smoothly. 7200 checkboxes are just too many. I think they can all be avoided. Your columns H and J appear designed to take test results. If a test result is entered a test was carried out. Therefore the checkbox certifying that fact seems superfluous. Just use CF to mark the cells with results in them or create adjacent cells with text like "tested". A formula can do that without user action. The checkboxes seem to have not much purpose other than keep the user busy - and slow down your workbook.


Answer the Question

You must create an account to use the forum. Create an Account or Login