Inserting checkboxes into undefined range (based on location of last column)

[AnNeRn]

Hi,

I've been looking all over the forums and can't see any questions relating to my query - apologies if this has been answered elsewhere.

I have a project tracking sheet that has a series of grouped columns tracking the status of each project.
The sheet has standard actions and owners for each project (detailed in column B - D) From column E onward is the grouped project references:

column 1 - checkboxes (each referenced into the cells they're located in with a VBA) to format the colours in column 2​

column 2 - due date​

column 3 - dividing column to separate the projects​

layout currently is (project 1 = e-f / project 2 = g-i / etc)​

​

I want to the ability to add new projects to the tracker as required (using a form button) which is where i'm struggling with the checkboxes. I have a blank template on sheet 2 but while I can copy and paste the columns (it finds the last column no problem, formatting and column sizes work fine) I can't get the checkboxes to appear. I'm now trying to find a way to insert checkboxes into column 1 but as there is no fixed cell destination (i don't want to limit the number of projects this can track) i can't get the examples I've found online to work.

Below is a vba i've found online, but in place of referencing cell E, is there a way to reference 2 columns back from last column? And it's not a must have, but if the checkboxes could also be centred in their cells, that would be great too.

Sub Addcheckboxes()
Dim cell, LRow As Single
Dim chkbx As CheckBox
Dim MyLeft, MyTop, MyHeight, MyWidth As Double

Application.ScreenUpdating = False
LRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

For cell = 6 To LRow
If Cells(cell, "A").Value <> "" Then
MyLeft = Cells(cell, "E").Left
MyTop = Cells(cell, "E").Top
MyHeight = Cells(cell, "E").Height
MyWidth = Cells(cell, "E").Width
ActiveSheet.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight).Select
With Selection
.Caption = ""
.Value = xlOff
.Display3DShading = False
End With
End If
Next cell

Application.ScreenUpdating = True

End Sub

 

[NoSparks]

Would be easiest to provide a solution if you post your existing macro that does the copy and paste of the columns from the template to the tracking sheet.

 

[AnNeRn]

Sorry NoSparks, didn't want to overwhelm my post - here is the code i've bastardised off Google!

Sub LinkCheckBoxes()
Application.ScreenUpdating = False

Dim NextCol As Long
NextCol = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column + 1

Sheet2.Range("A1:C32").Copy
With Sheet1.Cells(1, NextCol)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValues
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True

Dim chk As CheckBox
Dim lCol As Long
lCol = 0 'number of columns to the right for link
For Each chk In ActiveSheet.CheckBoxes
With chk
.LinkedCell = _
.TopLeftCell.Offset(0, lCol).Address
End With
Next chk
End Sub

 

[AnNeRn]

The checkboxes are in column A - they start at row 6 and continue to row 75 but there are a couple of gaps which is why i was trying to get the code in my initial post to work

 

[NoSparks]

Not sure I follow, but as best as I can interpret...

Centering the check box will have its left position half way across the width of the cell minus half the width of the check box.
You must then reduce the width to maintain the click area to be within the cell.

Sub LinkCheckBoxes()

     Dim NextCol As Long, lCol As Long
     Dim cel As Range, rng As Range
     Dim chk As CheckBox

Application.ScreenUpdating = False
NextCol = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column + 1

Sheet2.Range("A1:C32").Copy
With Sheet1.Cells(1, NextCol)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteColumnWidths
.PasteSpecial xlPasteValues
End With

Application.CutCopyMode = False

lCol = 0 'number of columns to the right for link

With ActiveSheet
    Set rng = .Range(.Cells(6, NextCol), .Cells(32, NextCol))  '<~~~~~ the range to have checkboxes
    For Each cel In rng.Cells
        With cel
            Set chk = .Parent.CheckBoxes.Add _
                    (Top:=.Top, _
                     Left:=.Left + (.Width / 2) - 8, _
                     Width:=.Width / 2, _
                     Height:=.Height)
            chk.Name = "chk_" & .Address(0, 0)
            chk.Caption = ""
            chk.Value = xlOff                         'initial value unchecked
            chk.LinkedCell = .Offset(0, lCol).Address '<~~~~~ offset to linked cell
        End With
    Next cel
End With

Application.ScreenUpdating = True

End Sub

 

[AnNeRn]

Thank you so much NoSparks!! Thats worked a treat!
Sorry for the late reply - I got a telling off for having my laptop open during the holidays!