Automatically Add and Delete Checkboxes

[SaraWitch]

Hello peeps.

I have a waiting list where I want a checkbox to appear in column V if data is entered in column C, from row 3. I have a code that (kind of!) works (I just have to manually add a checkbox to V3). But the code's not working to delete the checkbox when the row is cut or deleted (as well as row deletion, I want functionality to be able to move cancelled/completed applications to another sheet).

¦ MrExcel Queries.xlsm
	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V
3		test	Active																		FALSE
4		test	Active
5		test	Active
6		test	Active
LEC Current Waiting List (2)

Cell Formulas
Range	Formula
D3:D6	D3	=IF(C3="","",IF(NOT(ISBLANK(U3)),"Complete",IF(V3=TRUE,"Cancelled/Removed",IF(R3="Offered","Offer in progress",IF(R3="Accepted","Offer accepted",IF(S3=1,"One refused offer",IF(S3=2,"Two refused offers",IF(S3=3,"Three refused offers", "Active"))))))))
J3:J6	J3	=IF(K3="","",IF(ISNUMBER(MATCH(K3,'[LEC Garage Waiting List.xlsm]Lookups'!$E$4:$E$12, 0)), "Eastbourne Borough Council", "Lewes District Council"))

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
V3:V1048576	Expression	=$V3="TRUE"	text	NO
B3:V6	Expression	=$D3="Cancelled"	text	NO
B3:V6	Expression	=$D3="Complete"	text	NO
B3:V6	Expression	=$D3="Three refused offers"	text	NO
B3:V6	Expression	=$D3="Two refused offers"	text	NO
B3:V6	Expression	=$D3="One refused offer"	text	NO
B3:V6	Expression	=$D3="Offer in progress"	text	NO

Cells with Data Validation
Cell	Allow	Criteria
E3:E6	List	=Priority
R3:R1048576	List	=OfferStatus
S3:S1048576	List	=NoOfOffers
U3:U6	Date	between 01/01/1900 and 31/12/3000
I3:I6	Date	between 01/01/1900 and 31/12/3000
N3	List	=YesNo
K3:L6	List	=Area
M3:M6	List	=IntendedUse
N4:O1048576	List	=Area
P4:P1048576	List	=IntendedUse
Q4:Q1048576	List	=YesNo

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim chkBox As CheckBox
    Dim cmToPoints As Double
    Dim chkWidth As Double, chkHeight As Double
    Dim lastRow As Long
    Dim rowNum As Long
    Dim cell As Range
    Dim checkboxExists As Boolean

    ' Set the worksheet to the active sheet
    Set ws = Me
    cmToPoints = 28.35  ' Conversion factor from cm to points

    ' Define the size of the checkbox (in points)
    chkWidth = 0.6 * cmToPoints   ' 0.6 cm in points
    chkHeight = 0.59 * cmToPoints ' 0.59 cm in points

    ' Determine the last row with data in column C
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

    ' Check if the change is within the range of column C (where new data is entered)
    If Not Intersect(Target, ws.Range("C3:C" & lastRow)) Is Nothing Then
        ' Loop through each cell in the changed range
        For Each cell In Intersect(Target, ws.Range("C3:C" & lastRow))
            rowNum = cell.Row
            checkboxExists = False
            
            ' Check if there's already a checkbox in the current row in column V
            For Each chkBox In ws.CheckBoxes
                If chkBox.TopLeftCell.Row = rowNum Then
                    checkboxExists = True
                    Exit For
                End If
            Next chkBox
            
            ' Only add a checkbox if one does not already exist
            If Not checkboxExists Then
                ' Add the checkbox to the current row in column V
                Set chkBox = ws.CheckBoxes.Add(Top:=ws.Cells(rowNum, "V").Top, _
                                               Left:=ws.Cells(rowNum, "V").Left, _
                                               Width:=chkWidth, _
                                               Height:=chkHeight)
                
                ' Link the checkbox to the same cell in column V
                chkBox.LinkedCell = ws.Cells(rowNum, "V").Address
                
                ' Optional: Set the checkbox to default to uncheck
                chkBox.Value = xlOff
                
                ' Remove the text from the checkbox (this clears the label in the cell)
                chkBox.Text = ""
                
                ' Center the checkbox horizontally and vertically within the cell
                chkBox.Top = ws.Cells(rowNum, "V").Top + (ws.Cells(rowNum, "V").Height - chkHeight) / 2
                chkBox.Left = ws.Cells(rowNum, "V").Left + (ws.Cells(rowNum, "V").Width - chkWidth) / 2
            End If
        Next cell
    End If

    ' Check if the data in column C is cleared (row deleted or cut)
    If Not Intersect(Target, Me.Range("C3:C" & lastRow)) Is Nothing Then
        For Each cell In Intersect(Target, Me.Range("C3:C" & lastRow))
            If IsEmpty(cell.Value) Then
                ' Row is cleared, now delete the checkbox from the corresponding row in column V
                For Each chkBox In ws.CheckBoxes
                    If chkBox.TopLeftCell.Row = cell.Row Then
                        chkBox.Delete
                    End If
                Next chkBox
            End If
        Next cell
    End If
End Sub

Any help would be appreciated!

 

[bobsan42]

Do you really need Checkbox controls now that there are checkboxes in cell in O365?
I would see the point if you attach some macro to them, otherwise, if it is just about TRUE/FALSE I suggest you use the Checkbox formatted cell (Insert Tab on the Ribbon).

 

[SaraWitch]

Oh my! I really am overthinking it!! This is much easier!! Thank you!

Is there a way to automatically add to a new row in the table though?

 

[bobsan42]

to add:

    Range("V10").CellControl.SetCheckbox

to remove:

    Range("V10").ClearContents RemoveControls:=True
'or
    Range("V10").Clear

 

[SaraWitch]

Sorry, Bob; I'm still inexperienced with coding, so am unsure how the whole code would look...?

 

[bobsan42]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim rowNum As Long
    Dim cell As Range
    Dim cv As Range
    ' Set the worksheet to the active sheet
    Set ws = Me

    ' Determine the last row with data in column C
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

    ' Check if the change is within the range of column C (where new data is entered)
    If Not Intersect(Target, ws.Range("C3:C" & lastRow)) Is Nothing Then
        ' Loop through each cell in the changed range
        For Each cell In Intersect(Target, ws.Range("C3:C" & lastRow))
            rowNum = cell.Row
            Set cv = ws.Range("V" & rowNum)
            ' Check if the data in column C is cleared (row deleted or cut)
            If IsEmpty(cell.Value) Then
                ' Row is cleared, now delete the checkbox from the corresponding row in column V
                cv.ClearContents True
            Else
                ' Check if there's already a checkbox in the current row in column V
                If cv.CellControl.Type <> 2 Then 'xlTypeCheckbox
                    ' Only add a checkbox if one does not already exist
                    cv.CellControl.SetCheckbox
                End If
            End If
        Next cell
    End If
End Sub

 

[SaraWitch]

Amazing! Works perfectly; thank you so much, Bob!

 

[SaraWitch]

Hi Bob,

I have tried amending the code to include adding checkboxes to (new) columns H and I (and existing column (now X)) but am getting tied up in knots. Even tried the AI route to amend your code but none were working!

New example:

¦ MrExcel Queries.xlsm
	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X
2	Cx ID	Name	Status	Priority	Address	Existing tenant	Out of area	Telephone	E-mail	Application Date	Company	First Choice Area	Second Choice Area	Intended Use	Active Garage Agreement	Notes	Offer - Garage Address	Cx Garage Asset ID	Offer Status	Number of Offers	Cx Agreement Ref.	Agreement Start Date	Cancelled
3		test	Active
4		test	Active
Auto checkbox

Cell Formulas
Range	Formula
D3:D4	D3	=IF(C3="","",IF(NOT(ISBLANK(W3)),"Complete",IF(X3=TRUE,"Cancelled/Removed",IF(T3="Offered","Offer in progress",IF(T3="Accepted","Offer accepted",IF(U3=1,"One refused offer",IF(U3=2,"Two refused offers",IF(U3=3,"Three refused offers", "Active"))))))))
L3:L4	L3	=IF(M3="","",IF(ISNUMBER(MATCH(M3,'[LEC Garage Waiting List.xlsm]Lookups'!$E$4:$E$12, 0)), "Eastbourne Borough Council", "Lewes District Council"))

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
X3:X1048576	Expression	=$X3="TRUE"	text	NO
B3:X4	Expression	=$D3="Cancelled"	text	NO
B3:X4	Expression	=$D3="Complete"	text	NO
B3:X4	Expression	=$D3="Three refused offers"	text	NO
B3:X4	Expression	=$D3="Two refused offers"	text	NO
B3:X4	Expression	=$D3="One refused offer"	text	NO
B3:X4	Expression	=$D3="Offer in progress"	text	NO

Cells with Data Validation
Cell	Allow	Criteria
T3:T1048576	List	=OfferStatus
U3:U1048576	List	=NoOfOffers
E3:E4	List	=Priority
P3	List	=YesNo
M3:N4	List	=Area
O3:O4	List	=IntendedUse
P4:Q1048576	List	=Area
R4:R1048576	List	=IntendedUse
S4:S1048576	List	=YesNo
W3:W4	Date	between 01/01/1900 and 31/12/3000
K3:K4	Date	between 01/01/1900 and 31/12/3000

Any further help would be greatly appreciated

 

[SaraWitch]

*new columns G and H!

 

[bobsan42]

Column I (Telephone) does not look suitable for a checkbox. Do you mean G and H?
Are the conditions for a check box the same as before?
I am not sure I completely understand the new requirements but try this and can be adjusted further if needed:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim rowNum As Long
    Dim cell As Range
    Dim cv As Range
    ' Set the worksheet to the active sheet
    Set ws = Me

    ' Determine the last row with data in column C
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

    ' Check if the change is within the range of column C (where new data is entered)
    If Not Intersect(Target, ws.Range("C3:C" & lastRow)) Is Nothing Then
        ' Loop through each cell in the changed range
        With ws
            For Each cell In Intersect(Target, .Range("C3:C" & lastRow))
                rowNum = cell.Row
               
                ' Check if the data in column C is cleared (row deleted or cut)
                If IsEmpty(cell.Value) Then
                    ' Row is cleared, now delete the checkbox from the corresponding row in column V
                    .Range("X" & rowNum).ClearContents True
                    .Range("H" & rowNum).ClearContents True
                    .Range("G" & rowNum).ClearContents True
                Else
                    ' Check if there's already a checkbox in the current row in column V
                    If .Range("X" & rowNum).CellControl.Type <> 2 Then 'xlTypeCheckbox
                        ' Only add a checkbox if one does not already exist
                        .Range("X" & rowNum).CellControl.SetCheckbox
                    End If
                    If .Range("H" & rowNum).CellControl.Type <> 2 Then 'xlTypeCheckbox
                        ' Only add a checkbox if one does not already exist
                        .Range("H" & rowNum).CellControl.SetCheckbox
                    End If
                    If .Range("G" & rowNum).CellControl.Type <> 2 Then 'xlTypeCheckbox
                        ' Only add a checkbox if one does not already exist
                        .Range("G" & rowNum).CellControl.SetCheckbox
                    End If
                End If
            Next cell
        End With
    End If
End Sub