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