Using 'if.....then' loop with a Checkbox in VBA Excel - 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