Excel VBA: How do I PasteSpecial into same row of Cell location after Cell is changed?

Question

I want to have a specially formatted/formulated row (from a template worksheet) pasted onto the same row that's being modified on the main worksheet. This is what I have so far, but getting a run-time error 1004:

"PasteSpecial method of Ranged class failed"

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("A5:A10000")

    'the template of a very long formatted row with formulats
    Set TemplateRow = ActiveWorkbook.Worksheets("Templates").Range("A1:BB1")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
       Is Nothing Then

       TemplateRow.Copy
       Range(Target.Address).PasteSpecial Paste:=8
       Range(Target.Address).PasteSpecial Paste:=-4104
       Application.CutCopyMode = False
    Else
        Range(Target.Address).EntireRow.Delete
    End If
End Sub

Wouldn't pasting the values into the same range result in a worksheet_change which would then paste the special values in again causing infinite recursion, thus why it's probably not allowed? — xQbert, Jan 31 '14 at 22:10
http://stackoverflow.com/questions/13860894/ms-excel-crashes-when-vba-code-runs/13861640#13861640 — Siddharth Rout, Jan 31 '14 at 22:16
Instead of using `Range(Target.Address)` you can use `Target` so `Range(Target.Address).Value` becomes `Target.Value` — Siddharth Rout, Jan 31 '14 at 22:47

score 1 · Accepted Answer · answered Jan 31 '14 at 22:25

1

Can you try this for me? (UNTESTED)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range, TemplateRow As Range

    If Target.Cells.CountLarge > 1 Then Exit Sub

    On Error GoTo Whoa

    Application.EnableEvents = False

    Set KeyCells = Range("A5:A10000")

    Set TemplateRow = Worksheets("Templates").Range("A1:BB1")

    If Not Intersect(Target, KeyCells) Is Nothing Then
        TemplateRow.Copy
        Target.PasteSpecial Paste:=8

        DoEvents

        TemplateRow.Copy '<~~ Insurance against clipboard getting cleared
        Target.PasteSpecial Paste:=-4104
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

answered Jan 31 '14 at 22:25

Siddharth Rout

147,039
17
206
250

This works wonderfully! I added a bit of code to capture the value of the string i'm entering in column A because the pastespecial seems to overwrite it. Thank you! I'll paste the latest code up top. – Humble Val Jan 31 '14 at 22:36
Now that this works nicely, it only works when modifying one cell. Is there a way to allow this to work when modifying multiple cells (ex. paste in 3 rows of numbers)? – Humble Val Jan 31 '14 at 22:57
HINT: `If Target.Cells.CountLarge > 1 Then Exit Sub` :) – Siddharth Rout Feb 01 '14 at 06:42
I get a "Type Mismatch" if I omit the above line. – Humble Val Feb 03 '14 at 22:33
You will have to loop through the cells. for example `For each acell in target` where acell is defined as a range – Siddharth Rout Feb 03 '14 at 22:36

score 0 · Answer 2 · answered Apr 30 '18 at 17:09

Solution by OP.

Resolved thanks to Siddharth Rout.

Here is the full modified code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range, TemplateRow As Range
    Dim ArticleData As String

    If Target.Cells.CountLarge > 1 Then Exit Sub

    On Error GoTo Whoa

    Application.EnableEvents = False

    Set KeyCells = Range("A5:A10000")

    Set TemplateRow = Worksheets("Templates").Range("A1:BB1")

    If Not Intersect(Target, KeyCells) Is Nothing Then
        ArticleData = Range(Target.Address).Value
        If ArticleData <> "" Then
            TemplateRow.Copy
            Target.PasteSpecial Paste:=8

            DoEvents

            TemplateRow.Copy '<~~ Insurance against clipboard getting cleared
            Target.PasteSpecial Paste:=-4104
            Range(Target.Address).Value = ArticleData
        Else
            Range(Target.Address).EntireRow.Delete
        End If
    End If

    Letscontinue:
        Application.EnableEvents = True
        Exit Sub
    Whoa:
        MsgBox Err.Description
        Resume Letscontinue
End Sub

Excel VBA: How do I PasteSpecial into same row of Cell location after Cell is changed?

2 Answers2