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

darbar76528

New Member
Joined
Sep 2, 2017
Messages
11
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

Code:
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!
 
Well.... here goes

G6 to K6 is 5 cells,
what we're putting into them currently comes from
moving over one column from the checkbox... that's the .offset(0,1) part, which says zero rows down and one column to the right
then we take that cell, which is actually a single cell range and we resize the range with .resize(, 5), which means same number of rows and five columns

if the range expansion you want were G6 to M6 that would be 7 cells so we would use
ws.Range("G6:M6").Value = ws.Range(callersAddress).Offset(0, 1).Resize(,7).Value

This is just making one range of values equal to another range of values. It's quicker than copy and paste.
The got-ya is that it must be contiguous cells, if not, you're probably best to get the row to copy from application.caller and do two or more copy pastes.

Then the question becomes... how to get the row ?
Seeing that I tagged the address on the end of the name of each checkbox
and seeing all these checkboxes are all in column F, these two bits of code are essentially the same
and is what this part of the original macro is and what it could be

the first gets the address from the name, which is the part after CBX_ so from the fifth character on
and the other gets the row from the name, which is the part after CBX_F so from the sixth character on.
Code:
    'using range = range
    callersAddress = Mid(.Name, 5)
    ws.Range("G6:K6").Value = ws.Range(callersAddress).Offset(0, 1).Resize(, 5).Value
    
    'using copy and paste
    callersRow = Mid(.Name, 6)
    ws.Range("G" & callersRow, "K" & callersRow).Copy ws.Range("G6")


Hope that makes sense.
 
Upvote 0

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Forum statistics

Threads
1,223,911
Messages
6,175,324
Members
452,635
Latest member
laura12345

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top