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!

 

[SaraWitch]

Truly amazing; works perfectly (and I can add additional columns now)! Why did I waste my time with AI?! Thank you so much, Bob!

 

[SaraWitch]

Me again! I have some formulas in the table that I want to protect but when I do protect the sheet with a password, the table (new row) or code doesn't work. Is there a way around this?

 

[bobsan42]

General approach for most cases:
Unprotect (in the code)
Do stuff with code
Protect (with code)

Unless you are only doing allowed operations.

 

[SaraWitch]

I've tried this, but it's not working:

Book1
	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X
2	Company	ID	Name	Status	Priority	Applicant Address	Tenant	Out of Area	Applicant Telephone Number	Applicant E-mail	Application Date	First Choice Area	Second Choice Area	Intended Use	Active Agreement	Notes	Offer - Address (including postcode)	Asset ID	Offer Status	Number of Offers	Agreement Ref.	Agreement Start Date	Cancelled
3			test	Active	2
4			test	Active	2
5			test	Active	2
Auto checkbox

Cell Formulas
Range	Formula
E3:E5	E3	=IF(D3="","",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"))))))))
F3:F5	F3	=IF(D3="","", IF(I3=TRUE,"4", IF(P3=TRUE,"3", IF(AND(H3=TRUE,I3=FALSE,P3=FALSE),"1", IF(AND(H3=FALSE,I3=FALSE,P3=FALSE),"2")))))

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B3:X5	Expression	=$E3="Cancelled/Removed"	text	NO
B3:X5	Expression	=$E3="Complete"	text	NO
B3:X5	Expression	=$E3="Three refused offers"	text	NO
B3:X5	Expression	=$E3="Two refused offers"	text	NO
B3:X5	Expression	=$E3="One refused offer"	text	NO
B3:X5	Expression	=OR($E3="Offer in progress", $E3="Offer accepted")	text	NO

Cells with Data Validation
Cell	Allow	Criteria
T3	List	=OfferStatus
U3	List	=NoOfOffers
O3:O5	List	=IntendedUse
W3	Date	between 01/01/1900 and 31/12/3000
L3	Date	between 01/01/1900 and 31/12/3000
M3:N3	List	=Area
N4:N5	Date	between 01/01/1900 and 31/12/3000
F3:F5	Any value
B3:B5	Any value
S4:T1048576	List	=Area
U4:U1048576	List	=IntendedUse
V4:V1048576	List	=YesNo
W4:W1048576	List	=OfferStatus
X4:X1048576	List	=NoOfOffers
G4:G5	Any value

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
    Dim textBox As Shape
  
    Set ws = Me
  
    ws.Unprotect "Password"
  
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

    If Not Intersect(Target, ws.Range("C3:C" & lastRow)) Is Nothing Then
     
        With ws
            For Each cell In Intersect(Target, ws.Range("C3:C" & lastRow))
                rowNum = cell.Row
                If IsEmpty(cell.Value) Then
                    .Range("X" & rowNum).ClearContents True
                    .Range("H" & rowNum).ClearContents True
                    .Range("I" & rowNum).ClearContents True
                    .Range("P" & rowNum).ClearContents True
                Else
                    If .Range("X" & rowNum).CellControl.Type <> 2 Then 'xlTypeCheckbox
                        .Range("X" & rowNum).CellControl.SetCheckbox
                    End If
                    If .Range("H" & rowNum).CellControl.Type <> 2 Then 'xlTypeCheckbox
                        .Range("H" & rowNum).CellControl.SetCheckbox
                    End If
                    If .Range("I" & rowNum).CellControl.Type <> 2 Then 'xlTypeCheckbox
                        .Range("I" & rowNum).CellControl.SetCheckbox
                    End If
                    If .Range("P" & rowNum).CellControl.Type <> 2 Then 'xlTypeCheckbox
                        .Range("P" & rowNum).CellControl.SetCheckbox
                    End If
                End If
            Next cell
        End With
    End If
  
    On Error Resume Next
    Set textBox = ws.Shapes("Group Info")
    On Error GoTo 0
  
    If Not textBox Is Nothing Then
        textBox.Top = ws.Cells(lastRow + 1, 4).Top
    End If
  
    ws.Protect "Password", AllowFiltering:=True, AllowFormattingRows:=True, AllowDeletingRows:=True
End Sub

This unprotects and re-protects but if I start typing on next row (to include in table as it does when unprotected), it doesn't work...?

 

[SaraWitch]

Hi Bob,

Sorry, any idea why this isn't working for me?

 

[bobsan42]

Hi Bob,

Sorry, any idea why this isn't working for me?

I can't focus on this now.

off the top of my head I would say that a protected sheet introduces some limitations to the usual workflow.
So if it is important to protect, adapt the way you're used to work. There are many ways to do it.
The immediate one I can think of is a button to run code which adds a new row to the table.

However, best way to protect your data is to not give the users direct access to it.
e.g. design forms (UserForms or a sheet) where data is entered/edited in a "controlled" environment. then this data gets saved as one or more records in a database or table which the user never sees.

Also, this topic is different than the original.
To get help and not to confuse other users I suggest you mark this one as resolved and start a another thread for the new topic.

 

[SaraWitch]

Sorry, Bob; and thank you for your help so far. I shall start a fresh thread if needed...