Edit 2 - First Code Block modified to work with ActiveX Controls in Sheet.
- For a UserForm: Uncomment the comemnted out
If ... Then ' UserForm and
delete the following If line.
Edit 1 - Details on how to configure the Const user settings after the first code block.
I strongly encourage the use of the second code block. It removes this error prone kludge and the necessity to modify the code when there are checkbox changes (both the number of checkboxes and the destination sheet name associated with the checkbox).
COPY DISTINCT
If the destination should have distinct values in column D, only add rows which meet the condition.
Option Explicit
Private Const distinctCol = "D"
Private Const firstCol = "A"
Private Const lastCol = "D"
Private Const destination = "Landing Pad"
Private Const checkboxSource = "CheckBox1, IT Certification; CheckBox2, Business Skills & Productivity; CheckBox3, Database and Cybersecurity"
Private Const separator1 = ", " ' Checkbox Name <separator1> Worksheet Name
Private Const separator2 = "; " ' 1st box&sheet <separator2> 2nd box&sheet
Private Sub CommandButton1_Click()
Dim r As Long
Dim distinct As Boolean
Dim copiedRows As Long
Dim copyRowCount As Long
Dim copyRange As Range
Dim copyDistinct As Range
Dim Dws As Worksheet, Sws As Worksheet
Dim checkBoxAndSource As Variant
Set Dws = ThisWorkbook.Worksheets(destination)
Dws.Cells.ClearContents
Dws.Select
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
copiedRows = 0
For Each checkBoxAndSource In Split(checkboxSource, separator2)
'If Me(Split(checkBoxAndSource, separator1)(0)) Then ' UserForm
If Me.OLEObjects(Split(checkBoxAndSource, separator1)(0)).Object Then
Set Sws = ThisWorkbook.Worksheets(Split(checkBoxAndSource, separator1)(1))
Set copyRange = Nothing
Set copyDistinct = Nothing
copyRowCount = 0
For r = 1 To Sws.Range(distinctCol & Sws.Rows.Count).End(xlUp).Row
distinct = True
If copiedRows Then
distinct = Dws.Range(distinctCol & 1, distinctCol & _
copiedRows).Find(Sws.Cells(r, distinctCol)) Is Nothing
End If
If distinct And Not copyDistinct Is Nothing Then
distinct = copyDistinct.Find(Sws.Cells(r, distinctCol)) Is Nothing
End If
If distinct Then
If copyRowCount Then
Set copyRange = Union(copyRange, Sws.Range(firstCol & r, lastCol & r))
Set copyDistinct = Union(copyDistinct, Sws.Cells(r, distinctCol))
Else
Set copyRange = Sws.Range(firstCol & r, lastCol & r)
Set copyDistinct = Sws.Cells(r, distinctCol)
End If
copyRowCount = copyRowCount + 1
End If
Next r
If Not copyRange Is Nothing Then
copyRange.Copy destination:=Dws.Cells(copiedRows + 1, firstCol)
copiedRows = copiedRows + copyRowCount
End If
End If
Next checkBoxAndSource
End Sub
Edit: Const configuration.
- The three
Const, checkboxSource, separator1 and separator2 work in unison.
- The main
Const is checkboxSource.
- This is where the checkboxes are associated with their respective sheet names.
- There can be as few as one and as many as one likes.
- The
Const separator are only used to delimit the checkboxSource string.
- The comment following them describes what the separator is separating.
- The separators should include a space after the character if that is
the way the
checkboxSource string was formed.
- All three were set according to the original OP code so the OP would not need to change anything.
- The reason for not hard coding the separator values is because both
, and ; can be used in a sheet's name (although they should not be).
The whole CheckBox1 → "Sheet Name" is a bit kludgy.
This implementation uses the Form's Controls Properties instead.
To complete the implementation of this code, read the instructions for configuring the Form's Controls Properties following this code block.
Option Explicit
Private Const distinctCol = "D"
Private Const firstCol = "A"
Private Const lastCol = "D"
Private Sub CommandButton1_Click()
Dim r As Long
Dim distinct As Boolean
Dim copiedRows As Long
Dim copyRowCount As Long
Dim copyRange As Range
Dim copyDistinct As Range
Dim Dws As Worksheet, Sws As Worksheet
Dim ctrl As Control
Set Dws = ThisWorkbook.Worksheets(Me.CommandButton1.Tag)
Dws.Cells.ClearContents
Dws.Select
On Error Resume Next
Selection.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
copiedRows = 0
For Each ctrl In Me.Controls
If TypeName(ctrl) = "CheckBox" Then
If ctrl.GroupName = Me.CommandButton1.Tag Then
If ctrl Then
Set Sws = ThisWorkbook.Worksheets(ctrl.Tag)
Set copyRange = Nothing
Set copyDistinct = Nothing
copyRowCount = 0
For r = 1 To Sws.Range(distinctCol & Sws.Rows.Count).End(xlUp).Row
distinct = True
If copiedRows Then
distinct = Dws.Range(distinctCol & 1, distinctCol & _
copiedRows).Find(Sws.Cells(r, distinctCol)) Is Nothing
End If
If distinct And Not copyDistinct Is Nothing Then
distinct = copyDistinct.Find(Sws.Cells(r, distinctCol)) Is Nothing
End If
If distinct Then
If copyRowCount Then
Set copyRange = Union(copyRange, Sws.Range(firstCol & r, lastCol & r))
Set copyDistinct = Union(copyDistinct, Sws.Cells(r, distinctCol))
Else
Set copyRange = Sws.Range(firstCol & r, lastCol & r)
Set copyDistinct = Sws.Cells(r, distinctCol)
End If
copyRowCount = copyRowCount + 1
End If
Next r
If Not copyRange Is Nothing Then
copyRange.Copy destination:=Dws.Cells(copiedRows + 1, firstCol)
copiedRows = copiedRows + copyRowCount
End If
End If
End If
End If
Next ctrl
End Sub
These are the Property Settings for the Form Controls
- The CommandButton's
Tag is both:
- the Destination Sheet Name (OP: "Landing Pad") and
- the CheckBox's
GroupName
- The CheckBox's
Tag is its Source Sheet Name (OP: cb1.tag "IT Certification").
- The CheckBox's
GroupName is its associated CommandButton's Tag.
(See CommanButton's Tag above. This is also the Destination Sheet Name.)
- This convention allows the button to be associated with the checkboxes.
- It is a guard against the form's other checkboxes being included in the operation.
