Loop through Checkboxes and Concatenate Text - Without UserForm

E

ecronic

New Member
Joined
Nov 26, 2020
Messages
6
Office Version
  1. 2019
Platform
  1. Windows
Dear All
Just joined and have seen a lot of solutions for my other excel related issues here.

I have seen other related checkbox loop questions on the internet and here on this forum but I'm seeking for a solution without UserForm. I hope someone can help me.

I have 5 checkboxes on my excel sheet that will allow the user to select as per their liking. Once selected, there I have a table below that does calculations based on the rows where the check box are placed.

As per the attachment you can see that A1 & A2 are the selected checkboxes. So based on this selection the cell C10 will have the labels concatenated and cell C11 will show the total of both the selected cells. So, if someone selects the checkbox in A3 as well then all 3 amounts will be totaled and displayed in C11 and 3 labels concatenated together.

1606402440898.png
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Sort by date Sort by votes
Not sure if I understood you correctly because you mentioned C11 as sum of selected cell but example showed 1500.

Anyway, you do not need to loop the checkbox in worksheet but just trigger the macro to add number and deleted Lab ID. Here is the code

___________________
Option Explicit

Sub Summarize_CheckBox()

Dim n As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim cb As CheckBox

Set wb = ThisWorkbook
Set ws = wb.ActiveSheet
Set cb = ws.CheckBoxes(Application.Caller)

If cb.Value = xlOn Then
If ws.Range("C10") = "" Then
ws.Range("C10") = ws.Range("C10") & "Lab" & cb.Text
Else
ws.Range("C10") = ws.Range("C10") & "," & "Lab" & cb.Text
End If
ws.Range("C11") = ws.Range("C11") + ws.Range("D" & CLng(cb.Text) + 1)
Else
If InStr(ws.Range("C10"), "Lab" & cb.Text) = 1 Then
ws.Range("C10") = Replace(ws.Range("C10"), "Lab" & cb.Text, "")
n = Len(ws.Range("C10"))
If n > 0 Then
ws.Range("C10") = Right(ws.Range("C10"), n - 1)
End If
Else
ws.Range("C10") = Replace(ws.Range("C10"), ",Lab" & cb.Text, "")
End If
ws.Range("C11") = ws.Range("C11") - ws.Range("D" & CLng(cb.Text) + 1)
End If

End Sub
________________________

This is using the Form Control CheckBox on worksheet. You just need to assign this macro to each checkbox.
 
Upvote 0
Zot said:
Not sure if I understood you correctly because you mentioned C11 as sum of selected cell but example showed 1500.

Anyway, you do not need to loop the checkbox in worksheet but just trigger the macro to add number and deleted Lab ID. Here is the code

___________________
Option Explicit

Sub Summarize_CheckBox()

Dim n As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim cb As CheckBox

Set wb = ThisWorkbook
Set ws = wb.ActiveSheet
Set cb = ws.CheckBoxes(Application.Caller)

If cb.Value = xlOn Then
If ws.Range("C10") = "" Then
ws.Range("C10") = ws.Range("C10") & "Lab" & cb.Text
Else
ws.Range("C10") = ws.Range("C10") & "," & "Lab" & cb.Text
End If
ws.Range("C11") = ws.Range("C11") + ws.Range("D" & CLng(cb.Text) + 1)
Else
If InStr(ws.Range("C10"), "Lab" & cb.Text) = 1 Then
ws.Range("C10") = Replace(ws.Range("C10"), "Lab" & cb.Text, "")
n = Len(ws.Range("C10"))
If n > 0 Then
ws.Range("C10") = Right(ws.Range("C10"), n - 1)
End If
Else
ws.Range("C10") = Replace(ws.Range("C10"), ",Lab" & cb.Text, "")
End If
ws.Range("C11") = ws.Range("C11") - ws.Range("D" & CLng(cb.Text) + 1)
End If

End Sub
________________________

This is using the Form Control CheckBox on worksheet. You just need to assign this macro to each checkbox.
Click to expand...
Hi Zot,
So if I understand correctly, I should first create a macro and paste the above code. Then on the excel sheet add 5 x Form Control CheckBox and link them to the macro?
 
Upvote 0
Hi Zot,
I have added the code to my file and it works great. I have also remove the lines for C11 in the code as there no need of changing that Total. I realized I made a mistake in my 1st post. Thank you so much for your input. Can I trouble you with some additional query. I have attached the requirement in an excel file that should explain the solution I'm looking for. But, if there's any confusion do let me know.

1607425704597.png
 
Upvote 0
So if total tick =
1) 3 > [Lab1, Lab2, Lab3]
2) 4 > [Lab1, Lab2] + [Lab3, Lab4]
3) 5 > [Lab1, Lab2] +[Lab3, Lab4, Lab5]
4) 6 > [Lab1, Lab2, Lab3] + [Lab4, Lab5, Lab6] ?
5) 7 ?

I'm thinking of future expansion. The more Lab the Distribution will shift down as well, thus making write locations shifting. Therefore, the locations to write need to be variables as well.
 
Upvote 0
Zot said:
So if total tick =
1) 3 > [Lab1, Lab2, Lab3]
2) 4 > [Lab1, Lab2] + [Lab3, Lab4]
3) 5 > [Lab1, Lab2] +[Lab3, Lab4, Lab5]
4) 6 > [Lab1, Lab2, Lab3] + [Lab4, Lab5, Lab6] ?
5) 7 ?

I'm thinking of future expansion. The more Lab the Distribution will shift down as well, thus making write locations shifting. Therefore, the locations to write need to be variables as well.
Click to expand...
Yes, that is correct. Future expansion I'm not sure how many Lab(s) there will be as at the moment we are working with 5 Lab(s). May be you can code in additional 5 Lab(s) and keep them commented to be used in future. Or a system where once the new Lab(s) are added the Distribution will shift down accordingly. I know it's a bit of a task but appreciate your help in this. Also, design wise if you think there needs to be made any changes I don't mind. As long as it's simple to read.

Thanks again for your time.
Deven
 
Upvote 0
Zot said:
So if total tick =
1) 3 > [Lab1, Lab2, Lab3]
2) 4 > [Lab1, Lab2] + [Lab3, Lab4]
3) 5 > [Lab1, Lab2] +[Lab3, Lab4, Lab5]
4) 6 > [Lab1, Lab2, Lab3] + [Lab4, Lab5, Lab6] ?
5) 7 ?

I'm thinking of future expansion. The more Lab the Distribution will shift down as well, thus making write locations shifting. Therefore, the locations to write need to be variables as well.
Click to expand...
Sorry a quick note on the Distribution if there are more than 5 Lab(s).
So if total tick =
1) 3 > [Lab1, Lab2, Lab3]
2) 4 > [Lab1, Lab2] + [Lab3, Lab4]
3) 5 > [Lab1, Lab2] + [Lab3, Lab4, Lab5]
4) 6 > [Lab1, Lab2] + [Lab3, Lab4] + [Lab5, Lab6]
5) 7 > [Lab1, Lab2] + [Lab3, Lab4] + [Lab5, Lab6, Lab7]
6) 8 > [Lab1, Lab2] + [Lab3, Lab4] + [Lab5, Lab6] + [Lab7, Lab8]

So, if the Lab(s) are of an odd total number the last set should have 3 Lab(s) together and if even then 2 Lab(s) per distribution set.
 
Upvote 0
I was thinking too complicated on how to change the Balance if you untick one or several checkboxes and need to find where specific Labs were ?

The simple approach is just to delete everything and rewrite new table(s) according to requirement. So here is new code with other subroutines and function.

What you need to have on the worksheet is just this table

1607613132945.png

When you run the macro it will create the rest of the summary. Should work as many Lab and checkboxes. Tested to 5 checkboxes just fine. Here's the code:

VBA Code: 
Option Explicit

Public wb As Workbook
Public ws As Worksheet
Public cb As CheckBox
Public iRow As Long, eRow As Long, Total As Long

Sub Summarize_CheckBox()

Dim n&, m&, k&, cbTotal&, cbChkTotal&

Application.ScreenUpdating = False

Set wb = ThisWorkbook
Set ws = wb.ActiveSheet

For Each cb In ws.CheckBoxes
    If cb.Value = xlOn Then
        cbChkTotal = cbChkTotal + 1
    End If
    cbTotal = cbTotal + 1
Next

Set cb = ws.CheckBoxes(Application.Caller)
       
n = cbTotal + 4
Total = ws.Range("D" & n - 2)
iRow = n
eRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
If eRow < iRow Then eRow = iRow

ws.Range("A" & iRow, "A" & eRow).EntireRow.Delete
If cbChkTotal = 0 Then End

With ws.Range("B" & n)
    .Value = "Distribution"
    .Font.Bold = True
End With
With ws.Range("B" & n, "D" & n)
    .HorizontalAlignment = xlCenterAcrossSelection
    .VerticalAlignment = xlCenter
    .Interior.Color = 5296274
End With

Call DistBlock(ws.Range("B" & n))
For Each cb In ws.CheckBoxes
    If cb.Value = xlOn Then
ReFill:
    m = CountNum(ws.Range("C" & n + 1))
    k = 2
    If cbChkTotal = 1 Then k = 3
    If m < k Then
        Call FillData(ws.Range("C" & n + 1))
    Else
        n = n + 5
        Call DistBlock(ws.Range("B" & n))
        GoTo ReFill
    End If
    cbChkTotal = cbChkTotal - 1
   
    End If
Next

Application.ScreenUpdating = True

End Sub

Sub FillData(rngX As Range)

Set wb = ThisWorkbook
Set ws = wb.ActiveSheet

With rngX
    If .Value2 = "" Then
        .Value2 = .Value2 & "Lab" & cb.Text
    Else
        .Value2 = .Value2 & "," & "Lab" & cb.Text
    End If
    rngX.Offset(2, 0) = rngX.Offset(2, 0) * (-1)
    rngX.Offset(2, 0) = rngX.Offset(2, 0) + ws.Range("D" & CLng(cb.Text) + 1)
    rngX.Offset(2, 0) = rngX.Offset(2, 0) * (-1)
End With

End Sub

Sub DistBlock(rngX As Range)

With rngX
    With .Offset(1, 0)
        .Value = "Mar"
        .Font.Bold = True
    End With
    With .Offset(2, 0)
        .Value = "Total L."
        .Font.Bold = True
    End With
    With .Offset(2, 1)
        .Value = Total
        .Font.Bold = True
        .HorizontalAlignment = xlGeneral
    End With
    With .Offset(3, 0)
        .Value = "Selected"
    End With
    With .Offset(3, 1)
        .HorizontalAlignment = xlGeneral
    End With
    With .Offset(4, 0)
        .Value = "Balance"
        .Font.Bold = True
    End With
    With .Offset(4, 1)
        .Value = "=C" & .Row - 2 & "+" & "C" & .Row - 1
        .Font.Bold = True
        .Interior.ColorIndex = 6
        .HorizontalAlignment = xlGeneral
    End With
    With .Offset(4, 1)
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlDouble
            .Weight = xlThick
        End With
    End With
End With

End Sub

Function CountNum(rng As Range) As Long

Dim n&

For n = 1 To Len(rng)
    If IsNumeric(Mid(rng.Text, n, 1)) Then
        CountNum = CountNum + 1
    End If
Next

End Function

Cheers
 
Upvote 0
Solution
Zot said:
I was thinking too complicated on how to change the Balance if you untick one or several checkboxes and need to find where specific Labs were ?

The simple approach is just to delete everything and rewrite new table(s) according to requirement. So here is new code with other subroutines and function.

What you need to have on the worksheet is just this table

View attachment 27706

When you run the macro it will create the rest of the summary. Should work as many Lab and checkboxes. Tested to 5 checkboxes just fine. Here's the code:

VBA Code: 
Option Explicit

Public wb As Workbook
Public ws As Worksheet
Public cb As CheckBox
Public iRow As Long, eRow As Long, Total As Long

Sub Summarize_CheckBox()

Dim n&, m&, k&, cbTotal&, cbChkTotal&

Application.ScreenUpdating = False

Set wb = ThisWorkbook
Set ws = wb.ActiveSheet

For Each cb In ws.CheckBoxes
    If cb.Value = xlOn Then
        cbChkTotal = cbChkTotal + 1
    End If
    cbTotal = cbTotal + 1
Next

Set cb = ws.CheckBoxes(Application.Caller)
      
n = cbTotal + 4
Total = ws.Range("D" & n - 2)
iRow = n
eRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row
If eRow < iRow Then eRow = iRow

ws.Range("A" & iRow, "A" & eRow).EntireRow.Delete
If cbChkTotal = 0 Then End

With ws.Range("B" & n)
    .Value = "Distribution"
    .Font.Bold = True
End With
With ws.Range("B" & n, "D" & n)
    .HorizontalAlignment = xlCenterAcrossSelection
    .VerticalAlignment = xlCenter
    .Interior.Color = 5296274
End With

Call DistBlock(ws.Range("B" & n))
For Each cb In ws.CheckBoxes
    If cb.Value = xlOn Then
ReFill:
    m = CountNum(ws.Range("C" & n + 1))
    k = 2
    If cbChkTotal = 1 Then k = 3
    If m < k Then
        Call FillData(ws.Range("C" & n + 1))
    Else
        n = n + 5
        Call DistBlock(ws.Range("B" & n))
        GoTo ReFill
    End If
    cbChkTotal = cbChkTotal - 1
  
    End If
Next

Application.ScreenUpdating = True

End Sub

Sub FillData(rngX As Range)

Set wb = ThisWorkbook
Set ws = wb.ActiveSheet

With rngX
    If .Value2 = "" Then
        .Value2 = .Value2 & "Lab" & cb.Text
    Else
        .Value2 = .Value2 & "," & "Lab" & cb.Text
    End If
    rngX.Offset(2, 0) = rngX.Offset(2, 0) * (-1)
    rngX.Offset(2, 0) = rngX.Offset(2, 0) + ws.Range("D" & CLng(cb.Text) + 1)
    rngX.Offset(2, 0) = rngX.Offset(2, 0) * (-1)
End With

End Sub

Sub DistBlock(rngX As Range)

With rngX
    With .Offset(1, 0)
        .Value = "Mar"
        .Font.Bold = True
    End With
    With .Offset(2, 0)
        .Value = "Total L."
        .Font.Bold = True
    End With
    With .Offset(2, 1)
        .Value = Total
        .Font.Bold = True
        .HorizontalAlignment = xlGeneral
    End With
    With .Offset(3, 0)
        .Value = "Selected"
    End With
    With .Offset(3, 1)
        .HorizontalAlignment = xlGeneral
    End With
    With .Offset(4, 0)
        .Value = "Balance"
        .Font.Bold = True
    End With
    With .Offset(4, 1)
        .Value = "=C" & .Row - 2 & "+" & "C" & .Row - 1
        .Font.Bold = True
        .Interior.ColorIndex = 6
        .HorizontalAlignment = xlGeneral
    End With
    With .Offset(4, 1)
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlThin
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlDouble
            .Weight = xlThick
        End With
    End With
End With

End Sub

Function CountNum(rng As Range) As Long

Dim n&

For n = 1 To Len(rng)
    If IsNumeric(Mid(rng.Text, n, 1)) Then
        CountNum = CountNum + 1
    End If
Next

End Function

Cheers
Click to expand...
Zot... you are a lifesaver. Works exactly like the way I'd want it. Thank you very much.
 
Upvote 0
You must log in or register to reply here.

Similar threads

U
  • Solved
Checkboxes vs Drop Downs
2 3 4
Replies
38
Views
2K
My Aswer Is This
My Aswer Is This
P
  • Question Question
Looping through text boxes and checkbox captions on a user form
Replies
2
Views
482
NdNoviceHlp
NdNoviceHlp
F
  • Solved
Activating dynamically created checkboxes
Replies
2
Views
2K
Bosquedeguate
Bosquedeguate
U
  • Solved
Using checkboxes to populate a value if they are checked
2
Replies
11
Views
3K
kevin9999
K
P
  • Question Question
TypeScript (or other solutions) for modifying given list of cells (and similar problems)
Replies
0
Views
90
Pingaware
P

Forum statistics

Threads
1,223,888
Messages
6,175,205
Members
452,618
Latest member
Tam84

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top