Copy code for rest of the check boxes

[laxmandilip]

Hi , i have created Excel vba code for checkbox , when i click the check box its going to get the data from current sheet to another sheet .......... i want to create check boxes for entire column , is there an easy way to copy the code for each box ???? i have 200 check boxes , for each check box the range changes

Here's the code, i wrote for one check box



Private Sub CheckBox1_Click()

Dim strPath2 As String
Dim WbWorkbook1 As Workbook
Dim WbWorkbook2 As Workbook

strPath2 = "U:\F.P.EM-13 Trial Workbook.xlsx"

Set WbkWorkbook1 = ThisWorkbook
Set WbkWorkbook2 = Workbooks.Open(strPath2)

WbkWorkbook1.Worksheets("Sheet1").Range("H$7").Copy
WbkWorkbook2.Worksheets("Action List").Range("H17:J17").PasteSpecial

WbkWorkbook1.Worksheets("Sheet1").Range("G$7").Copy
WbkWorkbook2.Worksheets("Action List").Range("E7").PasteSpecial xlPasteValues

WbkWorkbook1.Worksheets("Sheet1").Range("C$7").Copy
WbkWorkbook2.Worksheets("Action List").Range("E12").PasteSpecial xlPasteValues

WbkWorkbook1.Worksheets("Sheet1").Range("E$7").Copy
WbkWorkbook2.Worksheets("Action List").Range("E14").PasteSpecial xlPasteValues

WbkWorkbook1.Worksheets("Sheet1").Range("D$7").Copy
WbkWorkbook2.Worksheets("Action List").Range("E13").PasteSpecial xlPasteValues





End Sub

 

[NoSparks]

Using form check boxes, this will get the row to copy

With ActiveSheet.CheckBoxes(Application.Caller)
    If .Value = xlOff Then
        Exit Sub
    Else
        'get the row
        x = Split(.TopLeftCell.Address, "$")
        rw = x(UBound(x))
    End If
End With

This is how I would do things.
Starting at row 7, place 200 form check boxes down column A with the assistance of this macro.

Private Sub Insert_Checkboxes()
     Dim myCell As Range, myRng As Range
     Dim CBX As CheckBox

With ActiveSheet
    'delete ALL existing checkboxes from sheet, links are NOT cleared.
    .CheckBoxes.Delete              '<~~~~~ comment out to NOT delete existing checkboxes
    'Exit Sub                       '<~~~~~ uncomment when deleting checkboxes ONLY.
    Set myRng = .Range("A7:A206")   '<~~~~~ enter the range to have checkboxes
End With
Application.ScreenUpdating = False
    For Each myCell In myRng.Cells
        With myCell
            Set CBX = .Parent.CheckBoxes.Add _
                (Top:=.Top, Left:=.Left, Width:=.Width, Height:=.Height) 'click area same size as cell
            CBX.Name = "CBX_" & .Address(0, 0)
            CBX.Caption = ""                            'whatever you want, "" for none
            CBX.Value = xlOff                           'initial value unchecked
            'CBX.LinkedCell = .Offset(0, 1).Address     '<~~~~~ offset to linked cell
            CBX.OnAction = "Module2.RunForAllChkBoxes"  '<~~~~~~~~~~ macro to call when clicked
        End With
    Next myCell
Application.ScreenUpdating = True
End Sub

Then in Module2, this macro which is called by each click of any of those checkboxes.

Sub RunForAllChkBoxes()
' https://www.mrexcel.com/board/threads/copy-code-for-rest-of-the-check-boxes.1126569/
' MrE member laxmandilip

    Dim strPath2 As String
    Dim WbkWorkbook1 As Workbook
    Dim WbkWorkbook2 As Workbook
    Dim x As Variant, rw As Long
    
With ActiveSheet.CheckBoxes(Application.Caller)
    If .Value = xlOff Then
        Exit Sub
    Else
        'get the row
        x = Split(.TopLeftCell.Address, "$")
        rw = x(UBound(x))
    End If
End With
            
strPath2 = "U:\F.P.EM-13 Trial Workbook.xlsx"

Set WbkWorkbook1 = ThisWorkbook
Set WbkWorkbook2 = Workbooks.Open(strPath2)

WbkWorkbook1.Worksheets("Sheet1").Range("H" & rw).Copy
WbkWorkbook2.Worksheets("Action List").Range("H17:J17").PasteSpecial xlPasteValues

WbkWorkbook1.Worksheets("Sheet1").Range("G" & rw).Copy
WbkWorkbook2.Worksheets("Action List").Range("E7").PasteSpecial xlPasteValues

WbkWorkbook1.Worksheets("Sheet1").Range("C" & rw).Copy
WbkWorkbook2.Worksheets("Action List").Range("E12").PasteSpecial xlPasteValues

WbkWorkbook1.Worksheets("Sheet1").Range("E" & rw).Copy
WbkWorkbook2.Worksheets("Action List").Range("E14").PasteSpecial xlPasteValues


WbkWorkbook1.Worksheets("Sheet1").Range("D" & rw).Copy
WbkWorkbook2.Worksheets("Action List").Range("E13").PasteSpecial xlPasteValues
    


End Sub

 

[laxmandilip]

im getting the error " unable to get the check boxes property of the worksheet class "

 

[NoSparks]

Works for me.

See this test file that just displays the row of the check box.

 

[laxmandilip]

Yes it works , Thank you ...... How do i align the check boxes to the center of the cell ?

 

[NoSparks]

By experimenting with the Top/Left/Width/Height values.
in this part

(Top:=.Top, Left:=.Left, Width:=.Width, Height:=.Height)

what's on the left side of the equal sign is referring to the check box and what's on the right is referring to the mycell.
The width of the square box is approx 16 so I'd try

(Top:=.Top, Left:=.Left + (.Width / 2) - 8, Width:=16, Height:=.Height)

 

[NoSparks]

(Top:=.Top + (.Height / 2) - 8, Left:=.Left + (.Width / 2) - 8, Width:=16, Height:=16)

 

[laxmandilip]

Thank you it works perfectly well

 

[NoSparks]

Hey, that's great & thanks for the feedback.