# Loop through Checkboxes and Concatenate Text - Without UserForm

#### ecronic

##### New Member
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.

### Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.

#### Zot

##### Well-known Member
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.

#### ecronic

##### New Member
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.
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?

#### ecronic

##### New Member
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.

#### Zot

##### Well-known Member

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.

#### ecronic

##### New Member
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.
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.

Deven

#### ecronic

##### New Member

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

#### Zot

##### Well-known Member
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

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

#### ecronic

##### New Member
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
Zot... you are a lifesaver. Works exactly like the way I'd want it. Thank you very much.

Replies
4
Views
403
Replies
4
Views
111
Replies
2
Views
289
Replies
0
Views
73
Replies
6
Views
243

1,127,000
Messages
5,622,122
Members
415,878
Latest member
jjj12345

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

### Which adblocker are you using?

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

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