VBA to Check/Uncheck Checkboxes

[Madraykin]

Hello guys, I've written some VBA to control some checkboxes but it's causing an issue that I can't quite get my head around fixing and was wondering if anyone here had any ideas.

So basically I have a stacked bar chart. I have a list of options (about 20) that can be individually clicked to see how these options will affect the chart (financially). These 20 options are also grouped into 'Packages'. So I've written some code (example below) to make it so that when Package 1 is selected, options 1, 2, 3 and 4 automatically have their boxes checked visually. The checkbox for Package 1 is linked to AA9, and AA10 displays the word 'YES' when AA9 reads TRUE

Private Sub Worksheet_Calculate()
If Range("AA10").Value = "YES" ThenActiveSheet.CheckBoxes("STLHM1").Value = xlOn
ActiveSheet.CheckBoxes("ATLHM").Value = xlOn
ActiveSheet.CheckBoxes("SAHM1").Value = xlOn
ActiveSheet.CheckBoxes("STLHM2").Value = xlOn
ActiveSheet.CheckBoxes("SAHM2").Value = xlOn
ActiveSheet.CheckBoxes("SAHM3").Value = xlOn
Else
ActiveSheet.CheckBoxes("STLHM1").Value = xlOff
ActiveSheet.CheckBoxes("ATLHM").Value = xlOff
ActiveSheet.CheckBoxes("SAHM1").Value = xlOff
ActiveSheet.CheckBoxes("STLHM2").Value = xlOff
ActiveSheet.CheckBoxes("SAHM2").Value = xlOff
ActiveSheet.CheckBoxes("SAHM3").Value = xlOff
End If
End Sub

The issue that I'm having is that I now need to be able to deselect individual checkboxes from the 20 long list to 'tailor' the packages. But because I have this code running I'm unable to do this. I was thinking it was something along the line of having this as an 'on-click' event for the checkbox rather than a worksheet_calculate - would this be correct thinking?

Any help appreciated, I'm tearing my hair out!!!!

Thanks guys

Mads

 

[dmt32]

Hi,
if the value in AA10 is changed by formula then you are using the right event. Unfortunately, if does not have the target parameter so you can limit your code to work when the required target range changes. As written, your code is running with each cell change & probably explains your issue.

There maybe a workaround you can try

Private Sub Worksheet_Calculate()
    Dim arr As Variant, Item As Variant
    
    arr = Array("STLHM1", "ATLHM", "SAHM1", "STLHM2", "SAHM2", "SAHM3")
    
 On Error GoTo exitsub
    Application.EnableEvents = False
    With Me.Range("AA10")
    If .Value <> .ID Then
        .ID = .Value
        For Each Item In arr
            ActiveSheet.CheckBoxes(Item).Value = IIf(UCase(.Value) = "YES", xlOn, xlOff)
        Next Item
    End If
    End With
exitsub:
    Application.EnableEvents = True
End Sub

Using Range.ID as a placeholder, allows you to compare the cells value & if it has changed, your code will update checkboxes.

Solution untested but hopefully, will do what you want.

Dave

 

[Madraykin]

Thanks so much Dave, will deploy it now and report back! Thanks so much for your help - sometimes you just can't see the wood for the trees and I think I'm having one of those mornings

 

[dmt32]

Thanks so much Dave, will deploy it now and report back! Thanks so much for your help - sometimes you just can't see the wood for the trees and I think I'm having one of those mornings

Hi,
most welcome, hopefully will do what you want.

Dave

 

[Madraykin]

Hi Dave

Thank you so much - this did indeed work, but try as I might I wasn't able to tweak it to extend over the entirety of my range and packages. I tweaked range and array names, but failed miserably (I'm still learning) - would you be able to give any pointers on extending it to work for the full code (I've had to obscure the checkbox names with 'Test' names) - any help would be greatly appreciated. Thanks (PS excuse the messy code - I'm a learner!)

Private Sub Worksheet_Calculate()    
If Range("O4").Value = "YES" Then
ActiveSheet.CheckBoxes("Test1").Value = xlOn
ActiveSheet.CheckBoxes("Test2").Value = xlOn
ActiveSheet.CheckBoxes("Test3").Value = xlOn
Else
ActiveSheet.CheckBoxes("Test1").Value = xlOff
ActiveSheet.CheckBoxes("Test2").Value = xlOff
ActiveSheet.CheckBoxes("Test3").Value = xlOff
End If


If Range("S4").Value = "YES" Then
ActiveSheet.CheckBoxes("Test4").Value = xlOn
ActiveSheet.CheckBoxes("Test5").Value = xlOn
Else
ActiveSheet.CheckBoxes("Test4").Value = xlOff
ActiveSheet.CheckBoxes("Test5").Value = xlOff
End If


If Range("W4").Value = "YES" Then
ActiveSheet.CheckBoxes("Test6").Value = xlOn
ActiveSheet.CheckBoxes("Test7").Value = xlOn
ActiveSheet.CheckBoxes("Test8").Value = xlOn
Else
ActiveSheet.CheckBoxes("Test6").Value = xlOff
ActiveSheet.CheckBoxes("Test7").Value = xlOff
ActiveSheet.CheckBoxes("Test8").Value = xlOff
End If


If Range("AA4").Value = "YES" Then
ActiveSheet.CheckBoxes("Test9").Value = xlOn
ActiveSheet.CheckBoxes("Test10").Value = xlOn
ActiveSheet.CheckBoxes("Test11").Value = xlOn
Else
ActiveSheet.CheckBoxes("Test9").Value = xlOff
ActiveSheet.CheckBoxes("Test10").Value = xlOff
ActiveSheet.CheckBoxes("Test11").Value = xlOff
End If


If Range("O10").Value = "YES" Then
ActiveSheet.CheckBoxes("Test12").Value = xlOn
ActiveSheet.CheckBoxes("Test13").Value = xlOn
Else
ActiveSheet.CheckBoxes("Test12").Value = xlOff
ActiveSheet.CheckBoxes("Test13").Value = xlOff
End If


If Range("S10").Value = "YES" Then
ActiveSheet.CheckBoxes("Test14").Value = xlOn
Else
ActiveSheet.CheckBoxes("Test14").Value = xlOff
End If


If Range("W10").Value = "YES" Then
ActiveSheet.CheckBoxes("Test15").Value = xlOn
Else
ActiveSheet.CheckBoxes("Test15").Value = xlOff
End If


If Range("AA10").Value = "YES" Then
ActiveSheet.CheckBoxes("STLHM1").Value = xlOn
ActiveSheet.CheckBoxes("ATLHM").Value = xlOn
ActiveSheet.CheckBoxes("SAHM1").Value = xlOn
ActiveSheet.CheckBoxes("STLHM2").Value = xlOn
ActiveSheet.CheckBoxes("SAHM2").Value = xlOn
ActiveSheet.CheckBoxes("SAHM3").Value = xlOn
Else
ActiveSheet.CheckBoxes("STLHM1").Value = xlOff
ActiveSheet.CheckBoxes("ATLHM").Value = xlOff
ActiveSheet.CheckBoxes("SAHM1").Value = xlOff
ActiveSheet.CheckBoxes("STLHM2").Value = xlOff
ActiveSheet.CheckBoxes("SAHM2").Value = xlOff
ActiveSheet.CheckBoxes("SAHM3").Value = xlOff
End If
End Sub

 

[dmt32]

Hi,
as a tip, always worth posting whole of code you have issues with.

Will see if can find time to update today for you but just need to understand if the values in your ranges being tested for "YES" are as a result of formula only change?

Dave

 

[Madraykin]

Hi Dave,

Will do in future, sorry, newbie error

The cells containing yes are indeed a formula - they display either a blank cell or a YES value depending on whether combinations of cells linked to checkboxes display TRUE, does that make sense?

Thank you so much for helping out

Mads

 

[dmt32]

Hi Dave,

Will do in future, sorry, newbie error

The cells containing yes are indeed a formula - they display either a blank cell or a YES value depending on whether combinations of cells linked to checkboxes display TRUE, does that make sense?

Thank you so much for helping out

Mads

Hi,

Yep makes sense just want to ensure I am using correct event.

Not tested but see if this update does what you want

Copy both codes to your sheets code page.

Option Base 1
Private Sub Worksheet_Calculate()
   Dim Cell As Range
   Dim i As Integer
 On Error GoTo exitsub
    Application.EnableEvents = False
    
    For Each Cell In Me.Range("AA10,O4,S4,W4,AA4,O10,S10,W10").Cells
        i = i + 1
        If Cell.Value <> Cell.ID Then Cell.ID = Cell.Value: ResetCheckBoxes Cell, i
    Next Cell


exitsub:
    Application.EnableEvents = True
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub


Sub ResetCheckBoxes(ByVal Target As Range, ByVal ArrIndex As Integer)
    Dim arr As Variant, Item As Variant
    arr = Array(Array("STLHM1", "ATLHM", "SAHM1", "STLHM2", "SAHM2", "SAHM3"), _
                Array("Test1", "Test2", "Test3"), _
                Array("Test4", "Test5"), _
                Array("Test6", "Test7", "Test8"), _
                Array("Test9", "Test10", "Test11"), _
                Array("Test12", "Test13"), _
                Array("Test14"), _
                Array("Test15"))
                
    For Each Item In arr(ArrIndex)
        Target.Parent.CheckBoxes(Item).Value = IIf(UCase(Target.Value) = "YES", xlOn, xlOff)
    Next Item
End Sub

Note Option Base 1 statement which MUST sit at VERY TOP of your worksheets code page OUTSIDE of any procedure.

Dave

 

[Madraykin]

Amazing - give me an hour to implement and I'll report back - you have saved my bacon! Thank you so much!

 

[Madraykin]

Working like a dream - Dave you are a genius. One day I hope to be well versed enough in this stuff that I can help people too!!!