Using 'if.....then' loop with a Checkbox in VBA Excel

Question

I am creating a VBA Excel program where I can copy the cell value to another sheet if its corresponding checkbox is checked. I have 278 "number" entries in one column and an corresponding individual "checkboxes" in one column. But when click the checkbox, the corresponding row text is not displayed.Instead it shows only the first 5 column values. For example, If I select 5 checkboxes randomly, it shows 1,2,3,4,5 numbers are displayed in the "sheet 2" columns.

Sub Button21_Click()
    Dim chkbx As CheckBox
    Dim i As Integer
    a = Worksheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To a
        For Each chkbx In ActiveSheet.CheckBoxes
            If chkbx.Value = xlOn Then
                Worksheets("sheet1").Cells(i, 1).Copy
                Worksheets("sheet2").Activate
                b = Worksheets("sheet2").Cells(i, 1).End(xlUp).Row
                Worksheets("sheet2").Cells(b + 1, 1).Select
                ActiveSheet.Paste
                i = i + 1
            End If
        Next chkbx
    Next i
End Sub

This is the code I've used. Any help would be appreciated.

Answer 1

An Objects Investigation

The Solution

The TopLeftCell Solution, The Solution, is based on the idea of Tim Williams suggested in the comments.

This will be in your sheet code (Sheet1).

Sub Button21_Click()
    executeCheckBoxes
End Sub

The rest will be in a standard module (e.g. Module1).

Sub executeCheckBoxes()

    Dim src As Worksheet     ' Source Worksheet (Object)
    Dim tgt As Worksheet     ' Target Worksheet (Object)
    Dim chkbx As CheckBox    ' CheckBox (For Each Control Variable)
    Dim srcLR As Long        ' Source Last Row
    Dim tgtER As Long        ' Target Empty Row
    Dim i As Long            ' Source Row Counter

    Set src = ThisWorkbook.Worksheets("Sheet1")
    Set tgt = ThisWorkbook.Worksheets("Sheet2")
    srcLR = src.Cells(src.Rows.Count, 1).End(xlUp).Row
    tgtER = tgt.Cells(tgt.Rows.Count, 1).End(xlUp).Row + 1

    For Each chkbx In src.CheckBoxes
        If chkbx.Value = xlOn Then
        ' Cell Version
            tgt.Cells(tgtER, 1).Value = _
              src.Cells(chkbx.TopLeftCell.Row, 1).Value
        ' The following 2 ideas are not so good. They are running into trouble
        ' when adding new checkboxes if not sooner.
        ' Index Version
            ' Assuming the index of the checkbox is 1 for row 2, 2 for 3 etc.
            ' Adjust the "+1" as needed.
'            tgt.Cells(tgtER, 1).Value = src.Cells(chkbx.Index + 1, 1).Value
        ' Name Version
            ' Assuming the name of the checkbox is "Check Box 1" for row 2,
            ' "Check Box 2" for 3 etc. Adjust the "+1" as needed.
'            tgt.Cells(tgtER, 1).Value = src.Cells(Val(Right(chkbx.Name, _
'                Len(chkbx.Name) - Len("Check Box "))) + 1, 1).Value
            tgtER = tgtER + 1
            Debug.Print chkbx.Name
        End If
    Next chkbx

End Sub

Extras

The following are codes used to help to create the two inferior solutions.

Sub deleteCB()
    deleteCheckBoxes ThisWorkbook.Worksheets("Sheet1")
End Sub

' Deletes all check boxes on a worksheet.
' Note: When you delete all check boxes, the 'counter' is not reset i.e. if you
'       e.g. had "Check Box 100" the next check box will be named "Check Box 101".
'       But after you save and close the workbook and open it again,
'       the first check box name will be "Check Box 1".
Sub deleteCheckBoxes(Sheet As Worksheet)
    Sheet.CheckBoxes.Delete
End Sub

' Creates check boxes in a range.
Sub addCheckBoxes()
    Const SheetName As String = "Sheet1"
    Const chkRange As String = "B2:B279"
    Const chkCaption As String = "Chk"
    Dim chk As CheckBox, rng As Range, cel As Range, i As Long
    i = 1
    With ThisWorkbook.Worksheets(SheetName)
        Set rng = .Range(chkRange)
        For Each cel In rng.Cells
            Set chk = .CheckBoxes.Add(cel.Left, cel.Top, cel.Width, cel.Height)
            With chk
                .Caption = chkCaption & i
            End With
            i = i + 1
        Next
    End With
End Sub

Sub showSomeCheckBoxProperties()
    Dim chk As CheckBox, rng As Range, cel As Range, i As Long
    i = 1
    With ThisWorkbook.Worksheets("Sheet1")
        For Each chk In .CheckBoxes
            With chk
                Debug.Print .BottomRightCell.Address, .Caption, _
                  .Characters.Count, .Enabled, .Index, .Name, .Placement, _
                  .Text, .TopLeftCell.Address, .Value, .Visible
            End With
        Next
    End With
End Sub

Extras 2

The following is the code based on the YouTube video Add Button to Worksheet and Assign a Macro to it -Excel Help by XLorate that helped quite a lot in answering this question.

Sub addButtons()
    Dim btn As Button, rng As Range, cel As Range, i As Long
    i = 1
    With ThisWorkbook.Worksheets("Sheet1")
        Set rng = .Range("A1:A3")
        For Each cel In rng.Cells
            Set btn = .Buttons.Add(cel.Left, cel.Top, cel.Width, cel.Height)
            With btn
                .Caption = "Macro" & i
                .OnAction = "Macro" & i
            End With
            i = i + 1
        Next
    End With
End Sub

The following are some other more or less helpful codes which I created while investigating objects.

Sub showSomeShapesProperties()
    Dim ws As Worksheet, sh As Shape
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    For Each sh In ws.Shapes
        With sh
            If sh.Type = 12 Then
                Debug.Print .Name, .Type, .ID, .OnAction, .TopLeftCell.Address
            End If
            If sh.Type = 8 Then
                Debug.Print .Name, .Type, .ID, .OnAction, .TopLeftCell.Address
            End If
        End With
    Next
End Sub

Sub showSomeOleObjectProperties()
    Dim ws As Worksheet, oo As OLEObject
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    For Each oo In ws.OLEObjects
        With oo
            Debug.Print .Name, .OLEType, .AutoLoad, .Enabled, .Index, _
              .BottomRightCell.Address
        End With
    Next
End Sub

Sub addOLECheckBoxes()
    Const srcName As String = "Sheet1"
    Dim chk As OLEObject, rng As Range, cel As Range, i As Long
    With ThisWorkbook.Worksheets(srcName)
        Set rng = .Range("A1:A10")
        i = 1
        For Each cel In rng.Cells
            Set chk = .OLEObjects.Add(ClassType:="Forms.CheckBox.1", _
              Left:=cel.Left, Top:=cel.Top, Width:=cel.Width, Height:=cel.Height)
            With chk
                '.Name = "Chk" & i
                '.Placement = xlMoveAndSize

            End With
            i = i + 1
        Next cel
    End With
End Sub