VBA to create and delete checkbox based on cell value

DYB

New Member
Joined
Jan 12, 2021
Messages
6
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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
 

Attachments

  • Form.png
    Form.png
    42.3 KB · Views: 12

Some videos you may like

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,016
Office Version
  1. 2016
Platform
  1. Windows
Not sure about Formula you talked about but since your code created the CheckBox just fine then try this:

VBA Code:
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

New Member
Joined
Jan 12, 2021
Messages
6
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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

Well-known Member
Joined
Nov 26, 2020
Messages
1,016
Office Version
  1. 2016
Platform
  1. Windows
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

VBA Code:
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

New Member
Joined
Jan 12, 2021
Messages
6
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

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.
 

Attachments

  • Screenshot 2021-01-14 153435.png
    Screenshot 2021-01-14 153435.png
    20.8 KB · Views: 3

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,016
Office Version
  1. 2016
Platform
  1. Windows
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

VBA Code:
        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

New Member
Joined
Jan 12, 2021
Messages
6
Office Version
  1. 365
  2. 2016
Platform
  1. Windows

ADVERTISEMENT

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

Well-known Member
Joined
Nov 26, 2020
Messages
1,016
Office Version
  1. 2016
Platform
  1. Windows
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?

 

DYB

New Member
Joined
Jan 12, 2021
Messages
6
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi Zot

Copy of file uploaded to google drive on following link

 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,016
Office Version
  1. 2016
Platform
  1. Windows
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
ABCDEF
1CAA EXAM/APPLICATION CHECKLIST
2
3Trainee NameDate of BirthCAA ReferenceEmailTelephone
4
5Exam/Application TypeCompleted by
6Licence : CPL
7Pre-Exam documents should be printed, certified (where necessary) and given to the trainee for submission to the examiner on arrival.
8Licence 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.
9ALL documents listed should be uploaded to Flight Logger.
10
111Certified copy - Passport or Driving Licence
122Skyborne Course Completion Certificate
133Certified Copy - CAA Course Completion Certificate SRG5008
144ATPL Theoretical Exam Results
155Certified Copy - Medical
166Certified Copy - Logbook
177Certified Copy - Licence
188Certified Copy - CAA CPL Examiners Report SRG2130
199MILITARY ONLY: Certified Copy - CAA Military Credit Form SRG2133
2010MILITARY ONLY: Certified Copy -Logbook pages (Special, QFI and IR Qualifications; last IR privileges)
2111 
2212 
2313 
2414 
Checklist
Cell Formulas
RangeFormula
B11:B24B11=IFERROR(INDEX(ExamDoc,MATCH($A$6&$A11,ExamType&ExamNo,0)),"")
Press CTRL+SHIFT+ENTER to enter array formulas.
Named Ranges
NameRefers ToCells
ExamDoc=Lookups!$E$2:$E$508B11:B24
ExamNo=Lookups!$D$2:$D$508B11:B24
ExamType=Lookups!$C$2:$C$508B11:B24
Cells with Conditional Formatting
CellConditionCell FormatStop If True
B24Cell Value=0textNO
B23Cell Value=0textNO
B22Cell Value=0textNO
B21Cell Value=0textNO
B20Cell Value=0textNO
B19Cell Value=0textNO
B18Cell Value=0textNO
B17Cell Value=0textNO
B16Cell Value=0textNO
B15Cell Value=0textNO
B14Cell Value=0textNO
B13Cell Value=0textNO
B12Cell Value=0textNO
A12Cell Value=0textNO
A14Cell Value=0textNO
A14Cell Value=0textNO
A13Cell Value=0textNO
B11Cell Value=0textNO
A11:A30Expression=$B11=""textNO
Cells with Data Validation
CellAllowCriteria
A6:D6List=Application_Type


I modified code a bit

VBA Code:
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
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,127,653
Messages
5,626,105
Members
416,161
Latest member
David1966Lewis

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top