Updating Column Reference for Series of Checkboxes Using Excel VBA-CodePudding

This is likely a quite simple question, but I'm having trouble bringing everything together myself. Essentially what I have are a series of checkboxes representing days of the month from April to December 2022 in calendar form. Each checkbox references cell in a 'calculator' sheet for the TRUE/FALSE value. This I was able to set up manually so they go from from 1 to 275 in order. However, I have multiple sheets representing a series of users—each with the same arrangement of checkboxes.

Currently, each checkbox is set up thusly:

=Calculator!$B$2

The column remains the same, but the row increases for each date. Pretty straightforward.

What I want to be able to do is update the column using Excel VBA so User 1 would be in column B (already set up), User 2 would be in column C, User 3 would be in column D, etc. Unfortunately, this is where I'm struggling with my knowledge of VBA.

The main issue is as I see it, is that the way I have the checkboxes organized, they're difficult to iterate through traditionally (i.e., they don't start at cell A1 and go down to cell A275). My solution was to simply replace the B column reference with the next column using a basic VBA script. I found one that iterates through the checkboxes and tried to combine it with the Replace function:

Sub LinkCheck()
    For Each cb In ActiveSheet.CheckBoxes
    cb.LinkedCell = Replace(Formula, "B", "C")
    Next cb
End Sub

While this script runs, it simply deletes the contents of the checkbox, rather than updating the column value. I've had an extensive look around for a solution, but the majority of answers I found are far more involved than my rather simple situation.

Apologies if the solution is exceptionally simple, I'm still trying to learn my way around VBA.

CodePudding user response：

Your best bet would be to rename your checkboxes in some consistent way so each one can be associated with a known row based on its name.

You can do that using code:

Dim cb, rw As Long

For Each cb In ActiveSheet.CheckBoxes
    rw = Range(cb.LinkedCell).Row
    Debug.Print cb.Name, rw
    cb.Name = "CbCal_" & Format(rw, "000") 'rename according to linked row
    Debug.Print cb.Name, rw
Next cb

You need to do a bit more work when switching out the columns though - otherwise the current checkbox setting will update the new column, rather than the new column updating the checkboxes.

Sub Tester()
    SetCheckBoxColumn "E"
    SetCheckBoxColumn "F"
    SetCheckBoxColumn "G"
End Sub

Sub SetCheckBoxColumn(colLetter As String)
    Const WS_NAME As String = "Calculator"
    Dim cb, rw As Long, c As Range, ws As Worksheet
    'probably want to specify a specific sheet and not ActiveSheet...
    For Each cb In ActiveSheet.CheckBoxes
        rw = CLng(Split(cb.Name, "_")(1))                 'using the naming from above...
        Set c = Worksheets(WS_NAME).Cells(rw, colLetter)  'get the linked cell
        cb.LinkedCell = ""                                'unlink the checkbox
        cb.Value = c.Value                                'set the checkbox value to the cell value
        cb.LinkedCell = WS_NAME & "!" & colLetter & rw    'relink the checkbox
    Next cb
End Sub

EDIT: after thinking about it more, this (below) would be better since it doesn't require renaming the checkboxes and is driven by the position of any existing linked cell.

Sub Tester()
    'SetCheckBoxColumn Sheet3, "E"
    'SetCheckBoxColumn Sheet3, "F"
    SetCheckBoxColumn Sheet3, "G"
End Sub

'Loop over all checkboxes on `wsCB` and adjust linked cell (if set) to
'   Column `ColLetter` on the same row
Sub SetCheckBoxColumn(wsCB As Worksheet, colLetter As String)
    Dim cb, rw As Long, c As Range, ws As Worksheet, lnk
    For Each cb In wsCB.CheckBoxes
        lnk = cb.LinkedCell
        If Len(lnk) > 0 Then
            Set c = Range(lnk)
            cb.LinkedCell = ""
            Set c = c.EntireRow.Columns(colLetter)
            cb.Value = c.Value
            cb.LinkedCell = "'" & c.Parent.Name & "'!" & c.Address
            Debug.Print lnk, cb.LinkedCell
        End If
    Next cb
End Sub