Copying & Pasting Values on Same Sheet to New Table - Pasting Issues...

[b4tmast]

First, I am a newbie and haven't got a clue what I'm doing. I appreciate any and all help.

I have a small table (Excel 2013) with 2 columns and from 21-24 rows with command buttons to the left on each row. I am trying to write a script so that when the checkbox to the left is checked it will copy the data from the two adjacent cells (columns B & C) and paste to a new table (column H2) - just two cells of data. The paste has to be of Values because the cells they're copying from have formulas.

When it goes to the new table it has to be able to know how many rows are there, if any, and then drop down to paste. When it starts, there are no rows of data. So the first paste will be the first row in the new table.

So far, miraculously, I got it to copy and paste - formulas though. Also, it copies whether or not, there is a check in the check box. So I'm not using my loops right, nor the code...

I have not added code for all the check boxes because I first need to get it to do the basics - after that I'll add the code with the other check boxes.

I'm sure this is simple to some, but, completely overwhelming to me. I've made it thus far and am ready to pull my hair out. Any and all help would be appreciated. Thank you:

Private Sub EstablishTagList()
 
Dim ws As Worksheet
Dim i As Long
 
' Initalize variables
Set ws = Sheets("DoorTags")
 
' Clear the contents of the Active Page
ws.Range("H2:I25").Clear
 
With ws  
            ws.Select
 
            ' Find the last row of data in the new Tag list.
            Lr = .Range("H2").End(xlDown).Row
             ' Loop through each row
            For i = 2 To Lr
           
             ' Decide if to copy based on command buttons in Column A
            If chkMaster.Value = True Then  'Once I figure out how to do this I will add all the other check boxes with If Conditionals.
                       
                        .Cells(i, 2).Resize(1, 2).Copy
                                    'Application.CutCopyMode = False
                       Sheets("DoorTags").Select
           
                        ActiveSheet.Cells(i, 8).PasteSpecial xlPasteValues
            End If

    Next
End With
 
End Sub

[b4tmast]

I thought it might be easier with a spreadsheet attached.

I've made progress on the pasting/special/values situation, however, I'm still having problems with the whole copying / pasting issue. It seems like it should be simple, but, when I try it, it just keeps going to the end of the sheet as well as ignoring the If then conditionals. Please help. What am I doing wrong? Thanks in advance. M.

Tags.xlsm

[mana]

istead of check boxes.


Sheet Module

Option Explicit


Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)


    If Intersect(Target, Range("A2:A25")) Is Nothing Then Exit Sub
    
    If Target.Value = ChrW(9745) Then
        Target.Value = ChrW(9744)
    Else
        Target.Value = ChrW(9745)
    End If


    Cancel = True
    
End Sub

Standard Module

Option Explicit


Sub test()
    Dim c As Range
    Dim n As Long
    
     
    Range("H2:I25").Clear
     
    For Each c In Range("a2", Range("a" & Rows.Count).End(xlUp))
        If c.Value = ChrW(9745) Then
            Range("H2:I2").Offset(n).Value = c.Offset(, 1).Resize(, 2).Value
            n = n + 1
        End If
    Next
     
End Sub

[b4tmast]

Mana,

First thanks for the response, I appreciate it. I seem to be missing something. How would the end user put in either a ChrW(9745) or a ChrW(9744)? What could be easier than a check box? The end user currently just checks a box for the specific items he wants and then that in turn prints the required widgets. Am I missing something? My issue is being able to copy over to the 'new' list at H2. Thanks again, and sorry if I missed something. Like I said, I'm a newbie.

[mana]

It is "event procedure".


1)right click on the sheet tab
2)select "view code"
3)copy and paste above code


then double click on cells of column-A

[b4tmast]

I must be daft... Nothing happens.

[b4tmast]

When I copied the module, nothing. But when I copied the sheet module, it worked. Thanks for the help that's a nice procedure. I will try the coding after that for the conditionals and next step. Thanks again.

[mana]

-

[b4tmast]

Actually, I've been helped in another site from 'DBY' and he gave this solution (which I will use):

Sub TagList()
Dim obj As Object
Dim r As Long, LastRow As Long
Dim Ws As Worksheet

Set Ws = Sheets("Sheet1")
LastRow = Ws.Range("H" & Rows.Count).End(xlUp).Row + 1

Ws.Range(Cells(2, 8), Cells(LastRow, 9)).ClearContents

With Ws
For Each obj In .OLEObjects
LastRow = Ws.Range("H" & Rows.Count).End(xlUp).Row + 1

If TypeName(obj.Object) = "CheckBox" Then
If obj.Object.Value = True Then
r = obj.TopLeftCell.Row
Ws.Cells(LastRow, 8) = Cells(r, 2)
Ws.Cells(LastRow, 9) = Cells(r, 3)
End If
End If
Next
End With

End Sub

Hope this helps somebody as DBY helped me. Mana thank you for your input as well. I played with it and like it. It's nice learning new things. Thanks one and all. I am grateful!