VBA code to Move entire row if checkbox is checked and also date stamp

[Penni]

This is my first post so bear with me if it is not perfect

If checkbox is checked VBA date stamps it with today's date and moves the entire row from worksheet "New Client" to another worksheet "Complete NC"

 

[Logit]

Sub CopyRows()
Dim chkbx As CheckBox
Dim r As Long
Dim LRow As Long

For Each chkbx In ActiveSheet.CheckBoxes
    If chkbx.Value = 1 Then
        For r = 1 To Rows.Count
            If Cells(r, 1).Top = chkbx.Top Then
                With Worksheets("Complete NC")
                    LRow = .Range("B" & Rows.Count).End(xlUp).Row + 1
                    .Range("B" & LRow) = Date
                    .Range("B" & LRow & ":D" & LRow) = Worksheets("New Clients").Range("A" & r & ":D" & r).Value
                    .Range("A" & LRow) = Format(Now, "mm-dd-yyyy")
                End With
                Exit For
            End If
        Next r
    End If
Next

End Sub

Download example workbook : Internxt Drive – Private & Secure Cloud Storage

 

[Alex Blakenburg]

@Logit, your example file is pretty flash.

You might want to make a couple of changes:

                    .Range("A" & LRow) = Date                                                                       ' Change to column A
                    .Range("B" & LRow & ":E" & LRow) = Worksheets("New Clients").Range("A" & r & ":D" & r).Value    ' Expand Target to E
                    .Range("A" & LRow) = Format(Now, "mm-dd-yyyy")                                                  ' Remove this or .Range("A" & LRow).NumberFormat = "mm-dd-yyyy"

 

[Logit]

Alex : Thank you for the heads up. Somehow I managed to copy the wrong macro to paste here. This is the correct macro ...

Sub CopyRows()
Dim chkbx As CheckBox
Dim r As Long
Dim LRow As Long

For Each chkbx In ActiveSheet.CheckBoxes
    If chkbx.Value = 1 Then
        For r = 1 To Rows.Count
            If Cells(r, 1).Top = chkbx.Top Then
                With Worksheets("Complete NC")
                    LRow = .Range("B" & Rows.Count).End(xlUp).Row + 1
                    .Range("A" & LRow) = Date
                    .Range("B" & LRow & ":E" & LRow) = Worksheets("New Clients").Range("A" & r & ":D" & r).Value
                    .Range("A" & LRow).NumberFormat = "mm-dd-yyyy"
                End With
                Exit For
            End If
        Next r
    End If
Next

 

[Logit]

Here is the link to download the example workbook :

Internxt Drive – Private & Secure Cloud Storage