VBA to create and delete checkbox based on cell value

[DYB]

I am a novice at VBA but am using some code to automatically create checkboxes on a form based on the value of the cell.

The value of the cell is determined by an 'iferror/index/match' formula and the 'iferror' part of the formula returns a blank value. I want the checkboxes to appear only if the formula result is an actual 'index' value. The VBA code below does work but my problem is that the checkboxes never disappear due having a formula in the cell. If I delete the formula the checkbox disappears but I need the formula to remain in the cells in each row as the number of rows containing actual values will vary depending on the number of 'index/match' values it finds. The form populates the rows based on the application type selected from a drop down list in cell A6 (snapshot of form attached)

Can someone help amend the code below so that it ignores formula written in cells and only reacts to actual values.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim chkbox As CheckBox
Dim cell As Range

If Not Intersect(Target, Range("B11:B1000")) Is Nothing Then
For Each cell In Intersect(Target, Range("B11:B1000"))
If Not IsEmpty(cell.Value) Then
'If the cell is NOT empty, I should add a checkbox, to the right of the cell without text
Set chkbox = Sheet1.CheckBoxes.Add(cell.Left, cell.Top, cell.Width, cell.Height)
With chkbox
.Text = ""
End With
Else
For Each chkbox In Sheet1.CheckBoxes
If Not Intersect(cell, chkbox.TopLeftCell) Is Nothing Then
chkbox.Delete
End If
Next chkbox
End If
Next cell
End If
End Sub

 

[Zot]

Not sure about Formula you talked about but since your code created the CheckBox just fine then try this:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim chkbox As CheckBox
Dim cell As Range

If Not Intersect(Target, Range("B11:B1000")) Is Nothing Then
    Set chkbox = Sheet1.CheckBoxes.Add(Target.Left, Target.Top, Target.Width, Target.Height)
    If Not Target.Value = 0 Or Not Target = "" Then
        chkbox.Text = ""
    Else
        For Each chkbox In Sheet1.CheckBoxes
            If Target.Address = chkbox.TopLeftCell.Address Then
                chkbox.Delete
            End If
        Next
    End If
End If

End Sub

 

[DYB]

Hi Zot

Thankyou for your response but that code is doing exactly the same as the original code. It creates checkboxes in every line due to the formula in the target cell. Is there any way to make it create the checkbox based on the formula result only?

 

[Zot]

Hi Zot

Thankyou for your response but that code is doing exactly the same as the original code. It creates checkboxes in every line due to the formula in the target cell. Is there any way to make it create the checkbox based on the formula result only?

Now understand that you meant the cell where the Checkbox is located contains formula. Worksheet Change event will not fire due to change by formula. Need to use Calculate

Try this

Private Sub Worksheet_Calculate()

Dim chkbox As CheckBox
Dim cell As Range

For Each cell In Range("B11", "B1000").SpecialCells(xlCellTypeFormulas)
    Set chkbox = Sheet1.CheckBoxes.Add(cell.Left, cell.Top, cell.Width, cell.Height)
    If cell = 0 Then
        For Each chkbox In Sheet1.CheckBoxes
            If cell.Address = chkbox.TopLeftCell.Address Then
                chkbox.Delete
            End If
        Next
    Else
        chkbox.Text = ""
    End If
Next

End Sub

 

[DYB]

Hi Zot

When I tried that one I got a 'Debug' come up as per the attached image.

Thank you for your help with this, I really do appreciate it.

 

[Zot]

I was assuming you are having only formula in range B11:B1000.

Try remove SpecialCells(xlCellTypeFormulas). Make it

For Each cell In Range("B11", "B1000")

I think better to add Application.ScreenUpdating = False. Fina code would be like this

        Private Sub Worksheet_Calculate()

Dim chkbox As CheckBox
Dim cell As Range

Application.ScreenUpdating=False
For Each cell In Range("B11", "B1000")
Set chkbox = Sheet1.CheckBoxes.Add(cell.Left, cell.Top, cell.Width, cell.Height)
If cell = 0 Then
For Each chkbox In Sheet1.CheckBoxes
If cell.Address = chkbox.TopLeftCell.Address Then
chkbox.Delete
End If
Next
Else
chkbox.Text = ""
End If
Next

End Sub

 

[DYB]

Hi Zot

I tried that code and it hangs up I'm afraid and goes into an endless loop of not responding.

The only cells on that worksheet that have formula are the range B11:B30 so I tried changing the range to that but it didn't make any difference. I do actually only need the range B11:B30 to add or delete checkboxes if that helps. The formula in those cells is =IFERROR(INDEX(ExamDoc,MATCH($A$6&$A11,ExamType&ExamNo,0)),"") and that works fine as it is accessing some lookup tables to find the data based on the selection made from a drop down list in cell A6.

The worksheet is protected to prevent users from accessing anything but cell A6 to select the exam/application type and I did wonder if that was causing any problems but I have also tried the code after I removed the protection and still got the same result.

 

[Zot]

No wonder you get to Debug before, The sheet is protected which SpecialCell normally gives error. However I have no idea why it could not work

Can you upload on Google drive or at least use XL2BB to copy and paste the actual sheet?

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...

www.mrexcel.com

 

[DYB]

Hi Zot

Copy of file uploaded to google drive on following link

Google Drive: Sign-in

Access Google Drive with a Google account (for personal use) or Google Workspace account (for business use).

drive.google.com

 

[Zot]

I just have a look at your workbook.

Actually the worksheets has has hundreds and hundreds of Checkboxes created on top of each others . So, when you delete one you still see CheckBox but it was not the same one ?

I have to go to Home>Find & Select>Select objects. Then use cursor to select all Checkboxes to delete them all and start from scratch.

I tried to re-enter the formula as array formula but it won't allow me since it is a merged cell. So, I un-merge those cells and re-enter as array formula. I use indent (3 levels) to re-align those texts.

I would suggest not use merge cell. Just make grid line invisible and draw boxes or borders wherever you wanted them to be. I think look nicer and avoid annoying merged cell.

The code still work with merge cell as I tried it. If I change selection in drop-down list, list with text will have CheckBox and line with no Text will not have one. This is how it looks like

Test CheckList.xlsm
	A	B	C	D	E	F
1	CAA EXAM/APPLICATION CHECKLIST
2
3	Trainee Name		Date of Birth	CAA Reference	Email	Telephone
4
5	Exam/Application Type				Completed by
6	Licence : CPL
7	Pre-Exam documents should be printed, certified (where necessary) and given to the trainee for submission to the examiner on arrival.
8	Licence documents should be printed, certified (if necessary) and given to the trainee for submission to HoT prior to departure from training at end of course.
9	ALL documents listed should be uploaded to Flight Logger.
10
11	1	Certified copy - Passport or Driving Licence
12	2	Skyborne Course Completion Certificate
13	3	Certified Copy - CAA Course Completion Certificate SRG5008
14	4	ATPL Theoretical Exam Results
15	5	Certified Copy - Medical
16	6	Certified Copy - Logbook
17	7	Certified Copy - Licence
18	8	Certified Copy - CAA CPL Examiners Report SRG2130
19	9	MILITARY ONLY: Certified Copy - CAA Military Credit Form SRG2133
20	10	MILITARY ONLY: Certified Copy -Logbook pages (Special, QFI and IR Qualifications; last IR privileges)
21	11
22	12
23	13
24	14
Checklist

Cell Formulas
Range	Formula
B11:B24	B11	=IFERROR(INDEX(ExamDoc,MATCH($A$6&$A11,ExamType&ExamNo,0)),"")
Press CTRL+SHIFT+ENTER to enter array formulas.

Named Ranges
Name	Refers To	Cells
ExamDoc	=Lookups!$E$2:$E$508	B11:B24
ExamNo	=Lookups!$D$2:$D$508	B11:B24
ExamType	=Lookups!$C$2:$C$508	B11:B24

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
B24	Cell Value	=0	text	NO
B23	Cell Value	=0	text	NO
B22	Cell Value	=0	text	NO
B21	Cell Value	=0	text	NO
B20	Cell Value	=0	text	NO
B19	Cell Value	=0	text	NO
B18	Cell Value	=0	text	NO
B17	Cell Value	=0	text	NO
B16	Cell Value	=0	text	NO
B15	Cell Value	=0	text	NO
B14	Cell Value	=0	text	NO
B13	Cell Value	=0	text	NO
B12	Cell Value	=0	text	NO
A12	Cell Value	=0	text	NO
A14	Cell Value	=0	text	NO
A14	Cell Value	=0	text	NO
A13	Cell Value	=0	text	NO
B11	Cell Value	=0	text	NO
A11:A30	Expression	=$B11=""	text	NO

Cells with Data Validation
Cell	Allow	Criteria
A6:D6	List	=Application_Type

I modified code a bit

Private Sub Worksheet_Calculate()

Dim chkbox As CheckBox
Dim cell As Range

For Each cell In Range("B11:B30")
    Set chkbox = Sheet1.CheckBoxes.Add(cell.Left, cell.Top, cell.Width, cell.Height)
    If Not cell.Text = "" Then
        chkbox.Text = ""
    Else
        chkbox.Text = ""
        For Each chkbox In Sheet1.CheckBoxes
            If cell.Address = chkbox.TopLeftCell.Address Then
                chkbox.Delete
            End If
        Next
    End If
Next

End Sub