Loop through Checkboxes and Concatenate Text - Without UserForm

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

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,174
Office Version
  1. 2016
Platform
  1. Windows
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
Joined
Nov 26, 2020
Messages
6
Office Version
  1. 2019
Platform
  1. Windows
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
Joined
Nov 26, 2020
Messages
6
Office Version
  1. 2019
Platform
  1. Windows
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
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,174
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

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
Joined
Nov 26, 2020
Messages
6
Office Version
  1. 2019
Platform
  1. Windows
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.

Thanks again for your time.
Deven
 

ecronic

New Member
Joined
Nov 26, 2020
Messages
6
Office Version
  1. 2019
Platform
  1. Windows

ADVERTISEMENT

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
Joined
Nov 26, 2020
Messages
1,174
Office Version
  1. 2016
Platform
  1. Windows
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
 
Solution

ecronic

New Member
Joined
Nov 26, 2020
Messages
6
Office Version
  1. 2019
Platform
  1. Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,125
Messages
5,640,266
Members
417,132
Latest member
Srw123

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
Top