Copy selected rows with checkboxes-CodePudding

I run this code ( from this answer ) to copy rows with selected checkboxes to another sheet, surprisingly, it also prints out rows with unselected checkboxes. The logic seems to be right, but I don't know why the output is wrong...

Sub Copy_to_new_sheet()
    Dim Row1 As Long, ChkBx As CheckBox, WS1 As Worksheet, WS2 As Worksheet
    Set WS1 = Worksheets("Top100") 'Source worksheet
    Set WS2 = Worksheets("Top100_Extract") 'Destination worksheet
    WS1.Rows(1).Copy 'Copy header in row 1
    WS2.Rows(1).PasteSpecial xlPasteValues 'Paste header in destination worksheet
    
    Row1 = WS1.Range("A" & Rows.Count).End(xlUp).Row   1
    For Each ChkBx In ActiveWorkbook.Sheets("Top100").CheckBoxes 'The sheet with ckeckboxes must be selected (ActiveSheet)
        If ChkBx.Value = 1 Then
            Row1 = Row1   1
            'Assign value to cells in destination sheet
            WS2.Cells(Row1, "A").Resize(, 14) = Range("A" & _
            ChkBx.TopLeftCell.Row).Resize(, 14).Value
        End If
    Next
End Sub

CodePudding user response：

Here's an approach which will work both for linked cells (the best and simplest way to ensure you're copying the correct cell) and also for cases where you need to check TopLeftCell to determine the row, and allows for some "drift" of the checkbox into the cell above.

Sub Copy_to_new_sheet()
    Const NUM_COLS As Long = 14    'use const for fixed values
    Dim Row1 As Long, ChkBx As CheckBox, WS1 As Worksheet, WS2 As Worksheet, wb As Workbook, c As Range
    
    Set wb = ActiveWorkbook                   'best to be explicit
    Set WS1 = wb.Worksheets("Top100")         'Source worksheet
    Set WS2 = wb.Worksheets("Top100_Extract") 'Destination worksheet

    WS2.Rows(1).Value = WS1.Rows(1).Value     'copy header data

    Row1 = WS1.Range("A" & Rows.Count).End(xlUp).Row   1 'first destination row
    
    For Each ChkBx In WS1.CheckBoxes
        If ChkBx.Value = 1 Then
            Set c = CheckBoxCell(ChkBx)
            WS2.Cells(Row1, "A").Resize(, NUM_COLS) = _
               c.EntireRow.Cells(1).Resize(1, NUM_COLS).Value
            Row1 = Row1   1
        End If
    Next
End Sub

'What cell is a checkbox linked to or "over"?
'Allows for a bit of drift when checking TopLeftCell
Function CheckBoxCell(ChkBx As Object) As Range
    Dim lnk, overlap
    
    lnk = ChkBx.LinkedCell
    If Len(lnk) > 0 Then 'does the checkbox have a linked cell? (##safest method##)
        Set CheckBoxCell = ChkBx.Parent.Range(lnk) 'use the linked cell
    Else
        'no linked cell, so get the TopLeftCell
        Set CheckBoxCell = ChkBx.TopLeftCell
        'how much of the checkbox is actually in that cell?
        overlap = CheckBoxCell.Height - (ChkBx.Top - CheckBoxCell.Top)
        'if less than 20% of the checkbox is in the TopLeftCell, use the next cell down
        If overlap / ChkBx.Height < 0.2 Then Set CheckBoxCell = CheckBoxCell.Offset(1)
    End If
    Debug.Print ChkBx.Parent.Name, ChkBx.Name, CheckBoxCell.Address
End Function

CodePudding user response：

Several things, too long for a comment:
a) If you copy code from an answer of SO, it is nice to reference it (same code can be found here: https://stackoverflow.com/a/73830937/7599798)
b) As far as I understand, the variable Row1 should hold the next free row of the destination sheet (WS2), but you calculate it by checking the source sheet (WS1)
So likely, that row should look like

Row1 = WS2.Range("A" & Rows.Count).End(xlUp).Row   1

c) My advice would be to name those variables like wsSource and wsDest and rowDest to make the meaning more obvious.
d) When copying the row, you are specifying the destination worksheet, but not the source worksheet, therefore the code will copy the data from the active sheet which is not necessarily the source sheet:

WS2.Cells(Row1, "A").Resize(, 14).Value = WS1.Range("A" & _
        ChkBx.TopLeftCell.Row).Resize(, 14).Value

e) If you run the code multiple times, the selected rows will be copied again and again. Not sure if this is intended.

Nothing explains why all rows are copied. As far as I remember, the OP of the linked question had another question asking how to create those checkboxes, but I can't find it anymore. If you did the same (creating the checkboxes via code): Are you sure that you don't have multiple checkboxes on top of each other? An unchecked box could hide a checked box that is exactly at the same position.

What you should do is to debug the code (execute is step by step) or set a breakpoint inside the If and look to the content of the chkBox (name, value, topLeftRow...).