Dyota's blog

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

#vba