Copy lines with checked boxes

The code below will generate the following reports (see below for details):

...

There are 3 sections, but all of the code must be inserted into one custom module:

...

Subs to execute:

Option Explicit

Private Const REPORT    As String = "Report_"
Private Const EXCLUDE   As String = "Sample"
Private Const L_COL     As String = "P"

Private wsRep As Worksheet
Private lRowR As Long

Public Sub updateSet1()
    updateSet 1
End Sub
Public Sub updateSet2()
    updateSet 2
End Sub
Public Sub updateSet3()
    updateSet 3
End Sub

Public Sub updateSet(ByVal id As Byte)
    Application.ScreenUpdating = False
    showSet id
    Application.ScreenUpdating = True
End Sub

Public Sub consolidateAllSheets()
    Application.ScreenUpdating = False
    With ThisWorkbook
        consolidateReport .Worksheets("COLON"), True  'time stamp to 1st line of report
        consolidateReport .Worksheets("LUNG")
        consolidateReport .Worksheets("MELANOMA")
        wsRep.Rows(lRowR).Borders(xlEdgeBottom).LineStyle = xlContinuous
    End With
    Application.ScreenUpdating = True
End Sub

      

        
        
        
      

    

...

showSet () - use 1 for Set1 , 2 for Set2 , 3 for edited Set2 :

Public Sub showSet(ByVal id As Byte)
    Dim ws As Worksheet, cb As Shape, lft As Double, mid As Double, thisWs As Worksheet
    Dim lRed As Long, lBlu As Long, cn As String, cbo As Object, s1 As Boolean

    If id <> 1 And id <> 2 And id <> 3 Then Exit Sub

    lRed = RGB(255, 155, 155): lBlu = RGB(155, 155, 255)
    Set thisWs = ThisWorkbook.ActiveSheet
    For Each ws In ThisWorkbook.Worksheets
        If InStr(1, ws.Name, REPORT, vbTextCompare) = 0 Then
            lft = ws.Cells(1, 2).Left
            mid = lft + ((ws.Cells(1, 2).Width / 2) - 5)
            For Each cb In ws.Shapes
                cn = cb.Name
                Set cbo = cb.OLEFormat.Object
                s1 = InStr(1, cn, "set1", 1) > 0
                If id < 3 Then
                    cb.Visible = IIf(s1, (id = 1), (id <> 1))
                    cb.Left = IIf(cb.Visible, mid, lft)
                    cbo.Interior.Color = IIf(s1, lBlu, lRed)
                Else
                    cb.Visible = True
                    cb.Left = IIf(s1, lft + 3, mid + 6.5)
                    cbo.Interior.Color = IIf(s1, lBlu, lRed)
                End If: ws.Activate
                With cbo
                    .Width = 15
                    .Height = 15
                End With
            Next
        Else
            ws.Visible = IIf((id = 3), -1, IIf(InStr(1, ws.Name, id) = 0, 0, -1))
        End If
    Next
    thisWs.Activate   'to properly update checkbox visibility
End Sub

      

        
        
        
      

    

...

consolidateReport ()

Public Sub consolidateReport(ByRef ws As Worksheet, Optional dt As Boolean = False)
    Dim fRowR As Long, vSetID As Byte, vSetName As String
    Dim lRow As Long, thisRow As Long, cb As Variant

    vSetID = IIf(ws.Shapes("cbSet2_03").Visible, 2, 1)
    vSetName = "Set" & vSetID
    Set wsRep = ThisWorkbook.Worksheets(REPORT & vSetID)
    fRowR = wsRep.Range("A" & wsRep.Rows.count).End(xlUp).Row
    If Not ws Is Nothing Then
        With ws
            lRow = .Range("A" & .Rows.count).End(xlUp).Row
            lRowR = fRowR + 1
            With wsRep.Cells(lRowR, 1)
                .Value2 = ws.name
                .Interior.Color = vbYellow
                If dt Then .Offset(0, 2) = Format(Now, "mmm dd yyyy, hh:mm AMPM")
            End With
            For Each cb In .Shapes
                If InStr(1, cb.name, vSetName, 0) Then
                    If cb.OLEFormat.Object.Value = 1 Then
                        thisRow = cb.TopLeftCell.Row
                        If InStr(1, .Cells(thisRow, 1).Value2, EXCLUDE, 1) = 0 Then
                            lRowR = lRowR + 1
                            wsRep.Range("A" & lRowR & ":" & L_COL & lRowR).Value2 = _
                                .Range("A" & thisRow & ":" & L_COL & thisRow).Value2
                        End If
                    End If
                End If
            Next
            If fRowR = lRowR - 1 Then
                wsRep.Cells(lRowR, 1).EntireRow.Delete
                lRowR = lRowR - 1
                MsgBox "No checkboxes checked for sheet " & ws.name
            End If
        End With
    End If
End Sub

      

        
        
        
      

    

...

The process starts with one file, which should have 2 sets of checkboxes on each sheet (column 2):

• cbSet1_01, cbSet1_02, cbSet1_03 ...
• cbSet2_01, cbSet2_02, cbSet2_03 ...

as in this picture

(checkbox colors will be reset by code if they follow the above naming convention)

...

• Create two files, one for Set1, the other for Set2 by running Sub updateSet()
  
  

  • showSet 1
    
    hides Set2 (Report_2 and all checkboxes on all sheets) - Save File1
  • showSet 2
    
    hides Set1 (Report_1 and all checkboxes on all sheets) - Save File2

• Distribute, then extract the updated files

  • Open file1 and run to create Report_1 Sub consolidateAllSheets()
    
    

  • Open file2 and run to create Report_2 Sub consolidateAllSheets()
    
    

    Compare Report_1 with Report_2

• Create a Set 2 for editing by doing Sub updateSet()
  
  

  • showSet 3
    
    shows Set1 and Set2 (all checkboxes and both reports) - Save File3

    Compare File1, File2 and File3