VBA code used to copy values to another place on the sheet

[darbar76528]

Greetings everyone. I have a code that i have running on two sheets of my workbook and they perform great. i am trying to implement the code into a third sheet and i cannot seem to make it work. I have included the 3 macros that i am attempting to implement. The goal is as follows:

1. With the "addcheckboxes" macro, place a checkbox starting in column F12 and continuing down column F to the end of a populated row referencing Column G.
2. When a checkbox is checked, i need for the checkbox click to copy the value of the corresponding column. For instance, if the F14 checkbox is clicked, then the values in G14:K14 would be copied up to G6:K6. Same worksheet.

In other words, if there is a checkbox in column F19 and a person clicked on it, it would copy the value of cells G19:K19 and paste the value into G6:L6

thanks for any help\assistance you can give me!

The sheet name that this code is going in to is "Sheet6" or Start Page

Sub Addcheckboxes()
Dim cell, LRow As Single
Dim chkbx As CheckBox
Dim MyLeft, MyTop, MyHeight, MyWidth As Double

Application.ScreenUpdating = False
LRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

For cell = 2 To LRow
    If Cells(cell, "A").Value <> "" Then
        MyLeft = Cells(cell, "$C").Left
        MyTop = Cells(cell, "$C").Top
        MyHeight = Cells(cell, "$C").Height
        MyWidth = Cells(cell, "$C").Width
        ActiveSheet.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight).Select
        With Selection
            .Caption = ""
            .Value = xlOff
            .Display3DShading = False
        End With
    End If
Next cell

Application.ScreenUpdating = True

End Sub

Sub CopyRows()
    With Sheet4.CheckBoxes(Application.Caller)
        If .Value = xlOn Then
             Sheet4.Range("L" & Sheet4.Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = Sheet4.Range(.TopLeftCell.Address).Offset(, -2).Resize(, 2).Value
           .Value = xlOff
        End If
    End With
End Sub

Sub RemoveCheckboxes()
'Dim chkbx As CheckBox

ActiveSheet.CheckBoxes.Delete

'For Each chkbx In ActiveSheet.CheckBoxes
'    chkbx.Delete
'Next

End Sub

Thanks for any assistance you can offer!

 

[NoSparks]

I don't see that line anywhere in the code suggested in post #2 .

Paste all the code, as is, from post #2 into a newly inserted module in the file you posted at that other site and run Insert_Checkboxes.
Does clicking on a checkbox not do what you wanted ?

 

[darbar76528]

Sheet6 code:

'Startup page copy rows
Sub CopyRowsstartup()
    Dim ws As Worksheet
    Dim callersAddress As String
    
Set ws = Sheet6
With ws.CheckBoxes(Application.Caller)
    'MsgBox .Name
    callersAddress = Mid(.Name, 5)
    ws.Range("G6:K6").Value = ws.Range(callersAddress).Offset(0, 1).Resize(, 5).Value
    .Value = xlOff
End With
End Sub
    
'Startup page checkboxes
Sub Addcheckboxesstartup()
     Dim lastrow As Long
     Dim myCell As Range, myRng As Range
     Dim CBX As CheckBox
With ActiveSheet
    ' get row of last used cell in column
    lastrow = .Cells(Rows.Count, "G").End(xlUp).Row
    ' specify the range to have checkboxes
    Set myRng = .Range("F12:F" & lastrow).SpecialCells(xlCellTypeVisible)
End With
' prevent screen flicker and speed things up
Application.ScreenUpdating = False
' put a checkbox in each cell of myRng
    For Each myCell In myRng.Cells
        With myCell
            ' specify the click area to be the entire cell
            Set CBX = .Parent.CheckBoxes.Add _
                (Top:=.Top, Left:=.Left, Width:=.Width, Height:=.Height)
            ' specify the properties of the checkbox
            CBX.Name = "CBX_" & .Address(0, 0)
            CBX.Caption = ""         'whatever you want, "" for none
            CBX.Caption = ""                        'whatever you want, "" for none
            'CBX.LinkedCell = .Offset(0, 1).Address  'linked cell
            CBX.OnAction = "CopyRows"                'macro to run on click
        End With
    Next myCell
    
Application.ScreenUpdating = True
End Sub
Sub RemoveCheckboxesstartup()
' removes checkboxes
' BUT does not clear linked cells
    ActiveSheet.CheckBoxes.Delete
End Sub

Sheet5

'Red barn workup page
Sub CopyRowsRedBarn()
    With Sheet5.CheckBoxes(Application.Caller)
        If .Value = xlOn Then
            Sheet5.Range("e" & Sheet5.Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = Sheet5.Range(.TopLeftCell.Address).Offset(, -2).Resize(, 2).Value
           .Value = xlOff
        End If
    End With
End Sub
    
'Red barn workup page
Sub Addcheckboxesredbarn()
Dim cell, LRow As Single
Dim chkbx As CheckBox
Dim MyLeft, MyTop, MyHeight, MyWidth As Double
Application.ScreenUpdating = False
LRow = ActiveSheet.Range("J" & Rows.Count).End(xlUp).Row
For cell = 2 To LRow
    If Cells(cell, "J").Value <> "" Then
        MyLeft = Cells(cell, "$L").Left
        MyTop = Cells(cell, "$L").Top
        MyHeight = Cells(cell, "$L").Height
        MyWidth = Cells(cell, "$L").Width
        ActiveSheet.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight).Select
        With Selection
            .Caption = ""
            .Value = xlOff
            .Display3DShading = False
        End With
    End If
Next cell
Application.ScreenUpdating = True

End Sub

Sheet4

' wooden building add checkboxes
Sub Addcheckboxes()
Dim cell, LRow As Single
Dim chkbx As CheckBox
Dim MyLeft, MyTop, MyHeight, MyWidth As Double
Application.ScreenUpdating = False
LRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
For cell = 2 To LRow
    If Cells(cell, "A").Value <> "" Then
        MyLeft = Cells(cell, "$C").Left
        MyTop = Cells(cell, "$C").Top
        MyHeight = Cells(cell, "$C").Height
        MyWidth = Cells(cell, "$C").Width
        ActiveSheet.CheckBoxes.Add(MyLeft, MyTop, MyWidth, MyHeight).Select
        With Selection
            .Caption = ""
            .Value = xlOff
            .Display3DShading = False
        End With
    End If
Next cell
Application.ScreenUpdating = True
End Sub
' wooden building copy rows
Sub CopyRows()
Dim ws As Worksheet
    Dim callersAddress As String
    
Set ws = ActiveSheet
    With ws.CheckBoxes(Application.Caller)
        If .Value = xlOn Then
             Sheet4.Range("L" & Sheet4.Rows.Count).End(xlUp).Offset(1).Resize(, 2).Value = Sheet4.Range(.TopLeftCell.Address).Offset(, -2).Resize(, 2).Value
           .Value = xlOff
        End If
    End With
End Sub
' wooden building remove checkboxes
Sub RemoveCheckboxes()
'Dim chkbx As CheckBox
ActiveSheet.CheckBoxes.Delete
'For Each chkbx In ActiveSheet.CheckBoxes
'    chkbx.Delete
'Next
End Sub

 

[darbar76528]

when i open a new workbook and insert the code and change the sheet name, the clear checkboxes and add checkboxes macro works beautifully, but the copy row does not copy but instead gives me an error message of "Cannot run the macro Book3.xlsm!copyrows', The macro may not be available in this workbook or all macros may be disabled. Oddly I know that this is the only workbook open and the macros are enabled. i also have changed the copy rows macro to Sheet1 to correspond to the new test worksheet. BTW: How do you upload excel file on this site? I wanted to upload this so you could tell me what I did wrong. Thanks!

 

[L. Howard]

Here is my shot at it.

Copy to a standard module and there must be a sheet named Start Page (or change in the code to match your sheet name)

Then check any box in F column (or un-check)
A checked box copies to the G6:K6 range.
An unchecked box prompts if you want to clear the box.row G-K values or not.

Howard

Option Explicit


Sub Add_Check_Boxes()


Dim cb As CheckBox
Dim myRange As Range, cel As Range
Dim wks As Worksheet
Dim bNum As Long, gCell As Long


gCell = Cells(Rows.Count, "G").End(xlUp).Row


Set wks = Sheets([I][B]"Start Page"[/B][/I])


Set myRange = wks.Range("F12:F" & gCell)


 bNum = 1
 
For Each cel In myRange


    Set cb = wks.CheckBoxes.Add(cel.Left, cel.Top, 40, 12)


    With cb
        
        .Caption = "cBox-" & bNum
        .LinkedCell = cel.Address
        .OnAction = "cBox_On_ActionEXP"
        
    End With
    
     cel.NumberFormat = ";;;"
     bNum = bNum + 1
     
Next


End Sub





Sub cBox_On_Action()


  Dim boxCell As Range
  Dim myCheck
  
  With ActiveSheet.Shapes(Application.Caller)
      Set boxCell = Range(.ControlFormat.LinkedCell)
      
      If .ControlFormat = xlOn Then


          boxCell.Offset(, 1).Resize(, 5).Copy Cells(6, 7)
      
      End If
  
      If .ControlFormat = xlOff Then
        
        boxCell.Offset(, 1).Resize(, 5).Select
        myCheck = MsgBox("Do you want to CLEAR these cells??", vbYesNo)
        
        If myCheck = vbNo Then
        
          boxCell.Select
          Exit Sub
          
         Else
         
          boxCell.Offset(, 1).Resize(, 5) = ""
          boxCell.Select
          
        End If
        
      End If
      
     End With
     
End Sub

 

[NoSparks]

You can't upload Excel files to this forum.
Upload to a site such as Dropbox or Box.com
mark it for sharing and you'll get a link to the file you can post here.

 

[darbar76528]

ok i did insert the code. the code will remove checkboxes and add checkboxes. When i click on a checkbox, i get the following error: "cannot run the macro "name of worksheet"!cbox_on_action EXP', The macro may not be available in this workbook or all macros may be disabled. i have opened up a ftp site and i have zipped up the original worksheet. If you can, could you download the workbook and take a look? module6 is where the code for the start page is located. Thanks! My workbook can be downloaded from here: ftp://excel:excel@67.76.196.174/excel/

 

[NoSparks]

If you're going to change the name of the macro that is to run when the checkbox is clicked
you also need to change it where it's being assigned with the CBX.OnAction = "CopyRowsstartup"

While you're there, remove one of the CBX.Caption lines, looks like copy and paste got me, they're both the same, only one is needed.

You will need to delete the existing checkboxes and re-insert them for things to take effect.

Good luck with your project.

 

[darbar76528]

Well, you did it! Code is working as expected. Thanks so much for all your time and energy spent on this!

 

[darbar76528]

One last thing, if I need to expand the column beyond K, what all do I need to change for that to occur?

callersAddress = Mid(.Name, 5)
    ws.Range("G6:K6").Value = ws.Range(callersAddress).Offset(0, 1).Resize(, 5).Value

 

[L. Howard]

Looks like you have a solution, but I wanted to correct an error in the code I posted code.

This...

    With cb
        
        .Caption = "cBox-" & bNum
        .LinkedCell = cel.Address
        .OnAction = "cBox_On_ActionEXP"
        
    End With

Should be...

    With cb
        
        .Caption = "cBox-" & bNum
        .LinkedCell = cel.Address
        .OnAction = "cBox_On_Action"
        
    End With

To remove the EXP from the .OnAction macro name. (typo on my part)


Ref: your last post on expand beyond column K, it looks like you would only need to increase the .Resize(, 5).Value to a larger number
i.e. .Resize(, 9).Value

Howard