Dynamically update the count of selected CheckBox in Excel using VBA - excel

Question

I am trying to find out a way to update the count of the selected checkboxes in excel using VBA.
i.e as the user selects the checkbox, the count has to get updated across the relevant filed. For example, If I select first check box ABC/18-49. The count at the top for (18-49) should get updated to 3.
P.S: This is how I have created the checkboxes dynamically.
Sub Main()
Dim Rng As Range
Dim WorkRng As Range
Dim Ws As Worksheet
On Error Resume Next
Set Ws = ThisWorkbook.Sheets(1)
Ws.Range("A:A").Insert
Set WorkRng = Ws.Range("A2:A" & Ws.UsedRange.Rows.Count)
Application.ScreenUpdating = False
For Each Rng In WorkRng
With Ws.CheckBoxes.Add(Rng.Left, Rng.Top, Rng.Width, Rng.Height)
.Characters.Text = "Yes"
End With
Next
WorkRng.ClearContents
WorkRng.Select
Application.ScreenUpdating = True
End Sub

Answer 1

Try the next way, please:
Copy the next Subs in a standard module and run the first one. It will assign a specific macro to all check boxes from column A:A:
Sub AssingMacro()
Dim sh As Worksheet, s As Shape, chkB As CheckBox
Set sh = ActiveSheet
For Each s In sh.Shapes
If left(s.Name, 6) = "Check " And s.TopLeftCell.Column = 1 Then
s.OnAction = "CheckBoxesHeaven"
End If
Next
End Sub
Sub CheckBoxesHeaven()
Dim sh As Worksheet, chB As CheckBox
Set sh = ActiveSheet
Set chB = sh.CheckBoxes(Application.Caller)
If chB.Value = 1 Then
Debug.Print chB.TopLeftCell.Offset(0, 2).Value
If chB.TopLeftCell.Offset(0, 2).Value = "18-49" Then
sh.Range("C3").Value = sh.Range("C3").Value + 1
ElseIf chB.TopLeftCell.Offset(0, 2).Value = "50-64" Then
sh.Range("C1").Value = sh.Range("C1").Value + 1
Else
sh.Range("C2").Value = sh.Range("C2").Value + 1
End If
Else
If chB.TopLeftCell.Offset(0, 2).Value = "18-49" Then
sh.Range("C3").Value = sh.Range("C3").Value - 1
ElseIf chB.TopLeftCell.Offset(0, 2).Value = "50-64" Then
sh.Range("C1").Value = sh.Range("C1").Value - 1
Else
sh.Range("C2").Value = sh.Range("C2").Value - 1
End If
End If
End Sub
Assort the values in range "C1:C3" to match the appropriate check boxes value. In order to automatically do that, please use the next code:
Sub ResetCheckBoxesValues()
Dim sh As Worksheet, chkB As CheckBox, i As Long
Dim V50_64 As Long, V18_49 As Long, VLess18 As Long
Set sh = ActiveSheet
For Each chkB In sh.CheckBoxes
If chkB.TopLeftCell.Column = 1 Then
Select Case chkB.TopLeftCell.Offset(0, 2).Value
Case "50-64"
If chkB.Value = 1 Then V50_64 = V50_64 + 1
Case "18-49":
If chkB.Value = 1 Then V18_49 = V18_49 + 1
Case "<18":
If chkB.Value = 1 Then VLess18 = VLess18 + 1
End Select
End If
Next
sh.Range("C1:C3").Value = Application.Transpose(Array(V50_64, VLess18, V18_49))
End Sub
Start playing with check boxes selection. It will add a unit to the appropriate cell if checking and decrease it with a unit in case of unchecking.
Please, test it and send some feedback

Answer 2

It will not be "very" dynamic, make sure to click on a random Excel cell, to make the formula recalculate after updating the check on the checkbox.
But the formula works in Excel, with the checkboxes you have created:
Public Function CountCheckBoxes()
Dim chkBox As Shape
Dim counter As Long
With ThisWorkbook.Worksheets(1)
For Each chkBox In .Shapes
If InStr(1, chkBox.Name, "Check Box") Then
If .Shapes(chkBox.Name).OLEFormat.Object.Value = 1 Then
counter = counter + 1
End If
End If
Next chkBox
End With
CountCheckBoxes = counter
End Function
Probably you should think about a suitable workaround to avoid ThisWorkbook.Worksheets(1), depending on where the code is residing.