Search code examples
excelvbauserform

How to add optional checkboxes based on the selection in excel VBA


I'm writing a Userform

What I am trying to achieve: while running my Userform with multiple selection checkboxes.

  1. Collect all checked checkboxes captions along with its parent frame name
  2. Filtering database on its first column with those collected strings
  3. Loop through filtered cells and make the wanted sums
  4. The selection can contain each row with different columns (Based on checkbox selection)

Coded for Estimate command button:

Private Sub preflight_calculate_Click()
    Dim preflight_resource As Double, preflight_time As Double

    preflight_resource = Val(Me.preflight_resource)
    preflight_time = Val(Me.preflight_time)
    Dim cell As Range
    With ThisWorkbook.Sheets("Preflight")
        With .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
            .AutoFilter 1, Criteria1:=GetCheckedCaptions, Operator:=xlFilterValues
            For Each cell In .SpecialCells(xlCellTypeVisible)
                preflight_resource = preflight_resource + cell.Offset(, 6).Value
                preflight_time = preflight_time + cell.Offset(, 8).Value
            Next
        End With
        .AutoFilterMode = False
    End With

    With Me
        .preflight_resource.Text = preflight_resource
        .preflight_time.Text = preflight_time
    End With
End Sub

Function GetCheckedCaptions() As Variant
    Dim ctl As Control
    With Me
        For Each ctl In .Controls
            If TypeName(ctl) = "CheckBox" Then
                If ctl.Value Then
                    GetCheckedCaptions = GetCheckedCaptions & " " & ctl.Parent.Caption & "-" & ctl.Caption
                End If
            End If
        Next
    End With
    GetCheckedCaptions = Split(Trim(GetCheckedCaptions))
End Function

Error code line:

preflight_resource = preflight_resource + cell.Offset(, 6).Value

Userform UI

Excel sheet(Database)

Expected result: For Example:

If I select the checkbox as follows US -> Mobile -> P0 and US -> Desktop -> P1

Output should be:

Textboxes below:

Resource Utilized: (F2 + G3) -> (0.73 + 0.62) -> 1.35 (Inside text box)

Time in Hours: (H2 + I3) -> (5.87 + 4.95) -> 10.82 (Inside text box)

How to achieve this?


Solution

  • I have a different approach to solve your question's problem.

    If having a separate columns to store the values of each selection is an option, then check it out.

    Summary of what happens in the spreadsheet:

    • Checkboxes data will be stored by VBA code in columns L to O

    • Cells L25 and N25 will sum total resources and time by adding the formulas (in each cell)

      L25 -> =SUM(L2:M23)

      N25 -> =SUM(N2:O23)

    Here you can download the current file: https://1drv.ms/x/s!ArAKssDW3T7wlKMfhNyjEDsHmkxz-g

    This will be the setup

    enter image description here

    The code behind the userform is as follows. Customize it reading each comment:

    Option Explicit
    
    
    Private Sub knightregression_yes_Change()
    
        Application.EnableEvents = False
    
        ' Record values according to checkboxes checked in form
        mUserForm.RecordCheckboxChange Me, Me.knightregression_yes, "Mobile", "Knight regression" ' In this case the task title is specified (last sub argument)
    
        Application.EnableEvents = True
    
    End Sub
    
    Private Sub preflight_no_Click()
    
        Application.EnableEvents = False
    
        ' Set userform's controls values depending on which one is calling the function
        SetUserFormControlsValues Me, Me.preflight_no
    
        Application.EnableEvents = True
    
    End Sub
    
    
    
    Private Sub preflight_yes_Click()
    
        Application.EnableEvents = False
    
        ' Set userform's controls values depending on which one is calling the function
        SetUserFormControlsValues Me, Me.preflight_yes
    
        Application.EnableEvents = True
    
    End Sub
    
    Private Sub us_desktop_Change()
    
        Application.EnableEvents = False
    
        ' Set userform's controls values depending on which one is calling the function
        SetUserFormControlsValues Me, Me.us_desktop
    
        Application.EnableEvents = True
    
    End Sub
    
    Private Sub us_dp0_Change()
    
        Application.EnableEvents = False
    
        ' Record values according to checkboxes checked in form
        mUserForm.RecordCheckboxChange Me, Me.us_dp0, "Desktop"
    
        Application.EnableEvents = True
    
    End Sub
    
    Private Sub us_mobile_Change()
    
        Application.EnableEvents = False
    
        ' Set userform's controls values depending on which one is calling the function
        SetUserFormControlsValues Me, Me.us_mobile
    
        Application.EnableEvents = True
    
    End Sub
    
    Private Sub us_mp0_Change()
    
        Application.EnableEvents = False
    
        ' Record values according to checkboxes checked in form
        mUserForm.RecordCheckboxChange Me, Me.us_mp0, "Mobile"
    
        Application.EnableEvents = True
    
    End Sub
    
    Private Sub us_mp1_Change()
    
        Application.EnableEvents = False
    
        ' Record values according to checkboxes checked in form
        mUserForm.RecordCheckboxChange Me, Me.us_mp1, "Mobile"
    
        Application.EnableEvents = True
    
    End Sub
    
    Private Sub us_mp2_Change()
    
        Application.EnableEvents = False
    
        ' Record values according to checkboxes checked in form
        mUserForm.RecordCheckboxChange Me, Me.us_mp2, "Mobile"
    
        Application.EnableEvents = True
    
    End Sub
    
    Private Sub us_yes_Change()
    
        Application.EnableEvents = False
    
        ' Set userform's controls values depending on which one is calling the function
        SetUserFormControlsValues Me, Me.us_yes
    
        Application.EnableEvents = True
    
    End Sub
    
    Private Sub UserForm_Initialize()
    
        Dim formControl As MSForms.Control
    
        ' Clear preflight selections
        ThisWorkbook.Worksheets("Preflight").Range("L2:O32").ClearContents
    
        ' Make all checkboxes unchecked and disabled except preflight test
        For Each formControl In Me.Controls
    
            If TypeOf formControl Is MSForms.CheckBox Then
    
                If InStr(formControl.Name, "preflight") = 0 Then
                    formControl.Value = False
                    formControl.Enabled = False
                End If
    
            End If
    
        Next
    
        ' Empty resource and time textboxes
        Me.preflight_resource = vbNullString
        Me.preflight_time = vbNullString
    
    End Sub
    
    Private Sub ComboBox2_Change()
    Dim index As Integer
    index = ComboBox2.ListIndex
    
    lstAll.Clear
    lstAll.MultiSelect = 2
    lst_Added.MultiSelect = 2
    Select Case index
        Case Is = 0
        With lstAll
    
    
               Dim i As Long, LastRow As Long
    LastRow = Sheets("Report").Range("A" & Rows.Count).End(xlUp).Row
    If Me.lstAll.ListCount = 0 Then
    For i = 2 To LastRow
    Me.lstAll.AddItem Sheets("Report").Cells(i, "A").Value
    Next i
    End If
    
    
            End With
        Case Is = 1
            With lstAll
                .AddItem "No Task"
            End With
        Case Is = 2
            With lstAll
                .AddItem "No Task"
            End With
    End Select
    
    End Sub
    
    Private Sub Newfeatureyes_Click()
    lstAll.MultiSelect = 2
    lst_Added.MultiSelect = 2
    Dim i As Long, LastRow As Long
    LastRow = Sheets("NewFeature").Range("A" & Rows.Count).End(xlUp).Row
    If Me.lstAll.ListCount = 0 Then
    For i = 2 To LastRow
    Me.lstAll.AddItem Sheets("NewFeature").Cells(i, "A").Value
    Next i
    End If
    End Sub
    
    Private Sub Newfeatureno_Click()
    lstAll.Clear
    lst_Added.Clear
    mobileutilize = ""
    mobilehours = ""
    desktoputilize = ""
    desktophours = ""
    
    End Sub
    
    
    
    
    
    Private Sub submitmobile_Click()
       Dim i As Long, j As Long, LastRow As Long
       Dim lbValue As String
       Dim ws As Worksheet
    
       If lst_Added.ListCount = 0 Then
           MsgBox "Please add atleast 1 task"
           Exit Sub
       End If
    
       mobileutilize = ""
       mobilehours = ""
    
       Set ws = ThisWorkbook.Sheets("NewFeature")
    
       With ws
           LastRow = .Range("A" & Rows.Count).End(xlUp).Row
    
           For i = 2 To LastRow
               For j = 0 To lst_Added.ListCount - 1
                   lbValue = lst_Added.List(j)
    
                   If .Cells(i, "A").Value = lbValue Or _
                      .Cells(i, "A").Value = Val(lbValue) Then
                       mobileutilize = Val(mobileutilize) + Val(.Cells(i, "F").Value)
                       mobilehours = Val(mobilehours) + Val(.Cells(i, "H").Value)
                   End If
               Next
           Next
       End With
    End Sub
    
    
    Private Sub submitdesktop_Click()
       Dim i As Long, j As Long, LastRow As Long
       Dim lbValue As String
       Dim ws As Worksheet
    
       If lst_Added.ListCount = 0 Then
           MsgBox "Please add atleast 1 task"
           Exit Sub
       End If
    
       desktoputilize = ""
       desktophours = ""
    
       Set ws = ThisWorkbook.Sheets("NewFeature")
    
       With ws
           LastRow = .Range("A" & Rows.Count).End(xlUp).Row
    
           For i = 2 To LastRow
               For j = 0 To lst_Added.ListCount - 1
                   lbValue = lst_Added.List(j)
    
                   If .Cells(i, "A").Value = lbValue Or _
                      .Cells(i, "A").Value = Val(lbValue) Then
                       desktoputilize = Val(desktoputilize) + Val(.Cells(i, "G").Value)
                       desktophours = Val(desktophours) + Val(.Cells(i, "I").Value)
                   End If
               Next
           Next
       End With
    End Sub
    
    
    Private Sub cmdAdd_Click()
       If lstAll.ListCount = 0 Then
           MsgBox "Select an item"
           Exit Sub
       End If
    Dim i As Integer
    For i = 0 To lstAll.ListCount - 1
        If lstAll.Selected(i) = True Then lst_Added.AddItem lstAll.List(i)
    Next i
    End Sub
    Private Sub cmdRemove_Click()
    
       If lstAll.ListCount = 0 Then
           MsgBox "Select an item"
           Exit Sub
       End If
    Dim counter As Integer
    counter = 0
    
    For i = 0 To lst_Added.ListCount - 1
        If lst_Added.Selected(i - counter) Then
            lst_Added.RemoveItem (i - counter)
            counter = counter + 1
        End If
    Next i
    End Sub
    
    Private Sub CommandButton1_Click()
    Unload Me
    Sheets("Estimation form").Select
    Range("A1").Select
    End Sub
    
    
    Private Sub ComboBox1_DropButtonClick()
    Dim i As Long, LastRow As Long
    LastRow = Sheets("Report").Range("A" & Rows.Count).End(xlUp).Row
    If Me.ComboBox1.ListCount = 0 Then
    For i = 2 To LastRow
    Me.ComboBox1.AddItem Sheets("Report").Cells(i, "A").Value
    Next i
    End If
    End Sub
    

    Also, add a module, name it: mUserForm and add this code:

    Option Explicit
    
    ' Set userform's controls values depending on which one is calling the function
    Public Sub SetUserFormControlsValues(mainUserForm As UserForm1, sourceControl As MSForms.Control)
    
        Dim formControl As MSForms.Control
    
        Dim enableMainCheckBoxes As Boolean
        Dim enableMobileCheckBoxes As Boolean
        Dim enableDesktopCheckBoxes As Boolean
        Dim enableMPCheckboxes As Boolean
        Dim enableDPCheckboxes As Boolean
    
        Dim countryCode As String
        Dim subcontrolList() As String
    
        Dim counter As Integer
    
        Select Case sourceControl.Name
    
        ' If preflight yes or no
        Case "preflight_yes"
            enableMainCheckBoxes = True ' xx_yes
            enableMobileCheckBoxes = False ' xx_mobile
            enableDesktopCheckBoxes = False ' xx_desktop
            enableMPCheckboxes = False ' xx_mpx
            enableDPCheckboxes = False ' xx_dpx
    
            subcontrolList = Split("yes", ",")
    
        Case "preflight_no"
            enableMainCheckBoxes = False ' xx_yes
            enableMobileCheckBoxes = False ' xx_mobile
            enableDesktopCheckBoxes = False ' xx_desktop
            enableMPCheckboxes = False ' xx_mpx
            enableDPCheckboxes = False ' xx_dpx
    
            subcontrolList = Split("yes", ",")
    
        ' If main box yes
        Case "us_yes", "uk_yes", "jp_yes", "de_yes", "es_yes", "it_yes", "fr_yes"
            enableMainCheckBoxes = True ' xx_yes
            enableMobileCheckBoxes = sourceControl.Value ' xx_mobile
            enableDesktopCheckBoxes = sourceControl.Value ' xx_desktop
            enableMPCheckboxes = False ' xx_mpx
            enableDPCheckboxes = False ' xx_dpx
    
            countryCode = Left(sourceControl.Name, InStr(sourceControl.Name, "_") - 1)
    
            subcontrolList = Split("mobile,desktop", ",")
    
        ' If mobile yes
        Case "us_mobile", "uk_mobile", "jp_mobile", "de_mobile", "es_mobile", "it_mobile", "fr_mobile"
            enableMainCheckBoxes = True ' xx_yes
            enableMobileCheckBoxes = True ' xx_mobile
            enableDesktopCheckBoxes = True ' xx_desktop
            enableMPCheckboxes = True ' xx_mpx
            enableDPCheckboxes = False ' xx_dpx
    
            countryCode = Left(sourceControl.Name, InStr(sourceControl.Name, "_") - 1)
    
            subcontrolList = Split("mp", ",")
    
        ' if desktop yes
        Case "us_desktop", "uk_desktop", "jp_desktop", "de_desktop", "es_desktop", "it_desktop", "fr_desktop"
            enableMainCheckBoxes = True ' xx_yes
            enableMobileCheckBoxes = True ' xx_mobile
            enableDesktopCheckBoxes = True ' xx_desktop
            enableMPCheckboxes = False ' xx_mpx
            enableDPCheckboxes = True ' xx_dpx
    
            countryCode = Left(sourceControl.Name, InStr(sourceControl.Name, "_") - 1)
    
            subcontrolList = Split("dp", ",")
    
        End Select
    
    
        For Each formControl In mainUserForm.Controls
    
            If TypeOf formControl Is MSForms.CheckBox Then
    
                ' Set sub controls value
                For counter = 0 To UBound(subcontrolList)
    
                    If sourceControl.Name = "preflight_yes" And InStr(formControl.Name, "preflight") = 0 And InStr(formControl.Name, countryCode & "_" & subcontrolList(counter)) > 0 Then
                        formControl.Enabled = True
                        formControl.Value = False
    
                    ElseIf sourceControl.Name = "preflight_no" And InStr(formControl.Name, "preflight") = 0 And InStr(formControl.Name, countryCode & "_" & subcontrolList(counter)) > 0 Then
                        formControl.Enabled = False
                        formControl.Value = False
    
                    ElseIf InStr(formControl.Name, "preflight") = 0 And InStr(formControl.Name, countryCode & "_" & subcontrolList(counter)) > 0 Then
                        formControl.Enabled = sourceControl.Value
                        formControl.Value = False
    
                    End If
    
                Next counter
    
            End If
    
        Next
    
        mainUserForm.releasenote_yes.Value = False
        mainUserForm.automationfail_yes.Value = False
        mainUserForm.knightregression_yes.Value = False
    
        mainUserForm.releasenote_yes.Enabled = True
        mainUserForm.automationfail_yes.Enabled = True
        mainUserForm.knightregression_yes.Enabled = True
    
        ' Empty resource and time textboxes
        mainUserForm.preflight_resource = vbNullString
        mainUserForm.preflight_time = vbNullString
    
    
    
    
    
    End Sub
    ' Record values according to checkboxes checked in form
    Public Sub RecordCheckboxChange(mainUserForm As UserForm1, checkBoxControl As MSForms.CheckBox, formType As String, Optional exactTaskTitle As String)
    
        ' Declare objects
        Dim resultRange As Range
    
        ' Declare other variables
        Dim parentCaption As String
        Dim checkboxCaption As String
        Dim taskTitle As String
        Dim resourceValue As Double
        Dim timeValue As Double
        Dim resourceColumn As Integer
        Dim timeColumn As Integer
    
        ' Reset find parameters
        Application.FindFormat.Clear
    
        ' Define which column to sum based on formType
        Select Case formType
    
        Case "Mobile"
    
            resourceColumn = 5
            timeColumn = 7
    
        Case "Desktop"
    
            resourceColumn = 6
            timeColumn = 8
    
        End Select
    
        ' Store the captions (parent and checkbox)
        parentCaption = checkBoxControl.Parent.Caption
        checkboxCaption = checkBoxControl.Caption
    
        ' If task title comes from code inside checkbox event, use it
        If exactTaskTitle <> vbNullString Then
    
            taskTitle = exactTaskTitle
    
        Else
    
            taskTitle = parentCaption & "*" & checkboxCaption
    
        End If
    
        ' Find the parent and checkbox caption (using wildcards it's more simple)
        Set resultRange = Sheets("Preflight").Range("A2:A32").Find(taskTitle, Lookat:=xlPart)
    
        ' If checkbox is checked record value
        If checkBoxControl.Value = True Then
            resourceValue = resultRange.Offset(0, resourceColumn).Value
            timeValue = resultRange.Offset(0, timeColumn).Value
        Else
            resourceValue = 0
            timeValue = 0
        End If
    
        ' Store the value in spreadsheet
        resultRange.Offset(0, resourceColumn + 6).Value = resourceValue
        resultRange.Offset(0, timeColumn + 6).Value = timeValue
    
        ' Update the textboxes with totals
        mainUserForm.preflight_resource = ThisWorkbook.Worksheets("Preflight").Range("L35").Value
        mainUserForm.preflight_time = ThisWorkbook.Worksheets("Preflight").Range("N35").Value
    
        ' Reset find parameters
        Application.FindFormat.Clear
    
    End Sub