Copy row when cell changes

**MCdyna** · 05-11-2020, 02:48 AM

Hello people,

I have a thing in my head, not sure if it is possible but if so, I bet someone here would know.

I have this table on sheet 1(Table1). If something changes in the 15th column I want that entire row copied and pasted on
sheet2 on the next blanc row.
And, the most exiting part... I want to past on that same row an additional cell the date of Today()

I know it has to be something with

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, ListObjects(Table1).ListColumns(15).DataBodyRange) Is Nothing Then

And something with

Target.Row.Copy
Sheets.Sheet2.Range("A" & Range("A" & Cells.Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

But everything I try, I get debugs.
And I don't even know where to start to add te Today()

Can someone please show me how this is done? If it is possible at all!

**Eastw00d** · 05-11-2020, 03:49 AM

Hi, maybe you can work with this:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LRow&, lCol&
    If Not Intersect(Target, Columns(15)) Is Nothing Then
        Range(Cells(Target.Row, 6), Cells(Target.Row, 19)).Copy  '<-- columns to be adjusted to your need
        LRow = Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1
        Worksheets(2).Range("A" & LRow).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        lCol = Worksheets(2).Cells(LRow, Columns.Count).End(xlToLeft).Column
        Worksheets(2).Cells(LRow, lCol + 1) = Date
    End If
End Sub

Cheers
Erwin

**MCdyna** · 05-11-2020, 04:47 AM

Thank you very much! I think I am doing something wrong, because it doens't do anything.

I don't know what target row 6 and target row 19 stands for.
When you open the attached file, does it work for you?

**Eastw00d** · 05-11-2020, 04:54 AM

yes, 6 and 19 are the begin and endcolumns of my Table, as you didn't provide a workbook, like now.
So you can adjust these numbers into 1 and 17.
Also I would change Worksheets(2) into Worksheets("Sheet2")

Cheers
Erwin

**MCdyna** · 05-11-2020, 05:16 AM

Getting half way there now

The debug I get is for

LRow = Worksheets(sheet2).Cells(Rows.Count, 1).End(xlUp).Row + 1

It says 'subscript out of range'

Often this is because a reference is not right, but in this case it is right.

I tried manually copy&paste a row in sheet2 so i know that it can find a new blanc row below it, still not working.

Any idea what I need to change?

**Eastw00d** · 05-11-2020, 05:40 AM

Yes, you have to use "quotes", like "Sheet2"

Cheers
Erwin

**MCdyna** · 05-11-2020, 06:01 AM

You are a master

Amazing, thank you very much!
And apologies for my stupid missing out on "" lol

Thank you a million times! Hero!

**MCdyna** · 05-11-2020, 06:14 AM

Just wondering.. Because I think this is all really amazing

Can you also make a mix with this code and another IF situation.

Like for instance:
If column N = "Patrick" AND column 15 is changed -> then copy and paste?

**Eastw00d** · 05-11-2020, 06:18 AM

No problem, but column 15 is the column where Patrick lives

Cheers
Erwin

**MCdyna** · 05-11-2020, 06:39 AM

Bad example.
So lets say I want column 6 to be "To do"

I try to make from:
If Not Intersect(Target, Columns(15)) Is Nothing Then

To:
If Not Intersect(Target, Columns(15)) Is Nothing And Intersect(Target, Columns(6)).Value = "To Do" Then

That didn't work, so I tried:

If Not Intersect(Target, Columns(15)) Is Nothing And Range("F:F").Value = "To Do" Then

I thought I could figure this addition out for myself.. But I think I am way off here.
Could you be so very kind of telling me how this one must be? Last question, I swear

**Eastw00d** · 05-11-2020, 06:54 AM

You cannot have two changes in one action, as you don't changetwo cells in the same time,
but you can do an if condition in the following line which determine if the code should be executed or not,
for example:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim LRow&, lCol&
    If Not Intersect(Target, Columns(6)) Is Nothing Then
        If Cells(Target.Row, 15) = "Patrick" Then
            
            Range(Cells(Target.Row, 1), Cells(Target.Row, 17)).Copy  '<-- columns to be adjusted to your need
            LRow = Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row + 1
            Worksheets("Sheet2").Range("A" & LRow).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            lCol = Worksheets("Sheet2").Cells(LRow, Columns.Count).End(xlToLeft).Column
            Worksheets("Sheet2").Cells(LRow, lCol + 1) = Date
        Else
            'Do nothing or execute code to be placed here
        End If
    End If
End Sub

Cheers
Erwin

**MCdyna** · 05-11-2020, 06:57 AM

Wow.. Amazing. Thank you very much!

**Eastw00d** · 05-11-2020, 07:02 AM

You better can change this line too, otherwise the line in Sheet2 will be overwritten every time:

            LRow = Worksheets("Sheet2").Cells(Rows.Count, 5).End(xlUp).Row + 1

(as column A seems to be empty)
Cheers
Erwin

Copy row when cell changes

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Copy row when cell changes

Re: Copy row when cell changes

Re: Copy row when cell changes

Re: Copy row when cell changes

Re: Copy row when cell changes

Re: Copy row when cell changes

Re: Copy row when cell changes

Re: Copy row when cell changes

Re: Copy row when cell changes

Re: Copy row when cell changes

Re: Copy row when cell changes

Re: Copy row when cell changes

Re: Copy row when cell changes

Thread Information

Users Browsing this Thread

Similar Threads

vba to copy certain elements in cell comments & copy to offset cell in same row

vba to copy and insert row and copy/paste cell value if cell not blank!

[SOLVED] Macro to copy cell width to new sheets (ie copy original sheet format)

[SOLVED] How to copy data in a cell in Sheet1 to a cell in Sheet2 using =COPY( )?

copy a specif cell value, find another like that in sheet copy adjacent cell and pate

[SOLVED] copy cell to another cell, increment and copy back.

Copy one cell to an other but colors do not copy. While not using clipboard to copy.

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions