VBA: Create checkboxes
' Program declarations
Option Explicit
' Variable declarations
Dim cb As Excel.CheckBox
Dim AllGroups As Range
Dim i As Integer
Public Sub GenerateCheckboxes()
' Takes all of the items in the tables allRoles and allGroups
' and makes a checkbox for each of those items
' in the Inputs page right under the roles table and the groups table
Application.ScreenUpdating = False
' Declare all variables
Dim Cell As Range
Dim DestinationSheet As Worksheet
Dim DestinationGroups As Range
Dim ReferenceSheet As Worksheet
' Reference ranges
Set ReferenceSheet = Sheets("reference")
Set AllGroups = ReferenceSheet.Range("allGroups")
' Destination ranges
Set DestinationSheet = Sheets("Inputs")
Set DestinationGroups = DestinationSheet.Range("groups")
' Put each item in reference range to corresponding cell in destination range
Call ForEveryItem(DestinationSheet, DestinationGroups, AllGroups, "cbGroup")
Application.ScreenUpdating = True
End Sub
Private Sub ForEveryItem(DestinationSheet As Worksheet, Destination As Range, Source As Range, Category As String)
' Generate a checkbox object for each item in Source
' right under the table named Category
For i = 1 To Source.Count
' Make checkboxes
DestinationSheet.Checkboxes.Add(Left:=Destination(5).Left, Top:=Destination(Destination.Count + i, 2).Top, Width:=Source.Width, Height:=Range("E1").Height).Select
' Set checkbox properties
With Selection
.Caption = Source(i, 1).Value
.Name = Category & i
End With
Next i
' Checkbox properties
' https://analysistabs.com/vba-code/activex-controls/checkbox/p/
End Sub
Public Sub FillInCheckboxValues()
Application.ScreenUpdating = False
' Based on the checkboxes that are ticked,
' fill in values into the table roles and the table groups
' This is so that Power Query can pick up on those values and
' run a query against the Roles and Groups sheet
Dim Checked As Boolean
Dim Inputs As Worksheet
Dim InputSheetName As String
' Inputs sheet
InputSheetName = "Inputs"
Set Inputs = Sheets(InputSheetName)
' Reference ranges
Set AllGroups = Sheets("reference").Range("allGroups")
Call FillInTableValues("Inputs", AllGroups, "groups", "cbGroup")
Application.ScreenUpdating = True
End Sub
Private Sub FillInTableValues(InputSheetName As String, Source As Range, TableName As String, CheckboxPrefix As String)
Application.ScreenUpdating = False
Dim Checked As Boolean
ClearTable (TableName)
' Go through all of the checkboxes that are named cbRoleXXX
' and check if it's ticked
' if it's ticked, write it into the table roles
For i = 1 To Source.Count
Checked = ThisWorkbook.Worksheets(InputSheetName).Shapes(CheckboxPrefix & i).OLEFormat.Object.Value = 1
If Checked Then
Call Add(TableName, Source(i, 1))
End If
Next i
Application.ScreenUpdating = True
End Sub
Public Sub ConfirmGroupsSelection()
Set AllGroups = Sheets("reference").Range("allGroups")
Call FillInTableValues("Inputs", AllGroups, "groups", "cbGroup")
End Sub
Private Sub Add(TableName As String, AddedItem As String)
' Add the string AddedItem to the last row of
' the table TableName
' Declare variables
Dim AddedRow As ListRow
Dim TableObject As ListObject
' Fetch table
Set TableObject = Sheets("Inputs").ListObjects(TableName)
' Add row to the end of the table
Set AddedRow = TableObject.ListRows.Add()
' Add last item to the table
With AddedRow
.Range(1) = AddedItem
End With
End Sub
Private Sub ClearTable(TableName As String)
' Delete all of the rows in the table called TableName
Dim TableObject As ListObject
Dim TableRange As Range
' Set up variables
Set TableObject = Sheets("Inputs").ListObjects(TableName)
Set TableRange = Sheets("Inputs").Range(TableName)
' Loop through
For i = 1 To TableRange.Count - 1
TableObject.ListRows(1).Delete
Next i
If TableObject.ListRows.Count > 0 Then
TableObject.ListRows(1).Delete
End If
End Sub
Private Sub ClearCheckboxes(Category As String)
' Uncheck all of the checkboxes on the sheet
' Category is either "Role" or "Group"
Application.ScreenUpdating = False
For Each cb In ActiveSheet.Checkboxes
If InStr(1, cb.Name, Category) Then
cb.Value = 0
End If
Next cb
Application.ScreenUpdating = True
End Sub
Public Sub ClearCheckboxesGroups()
ClearTable ("groups")
ClearCheckboxes ("Group")
End Sub
Public Sub DeleteAllCheckboxes()
' Delete all of the checkboxes on the screen
' Only used for development purposes
For Each cb In ActiveSheet.Checkboxes
cb.Delete
Next cb
End Sub