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

Question

I'm writing a Userform
What I am trying to achieve: while running my Userform with multiple selection checkboxes.
Collect all checked checkboxes captions along with its parent frame name
Filtering database on its first column with those collected strings
Loop through filtered cells and make the wanted sums
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
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?

Answer 1

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
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