Worksheet Change Macro with multiple Keycell ranges

[owstie]

Hi, I’m trying to make the most recent input change made to cells in a series of ranges automatically be copied and pasted elsewhere (which then it turn triggers a vlookup but that bit is fairly irrelevant).

I’ve managed to create a Worksheet Change macro but I get the “Run-time error ‘1004’: Method ‘Range’ of object ’_Worksheet’ failed” whenever I input one of the cells in the ranges.
It works fine if I only have 20 ranges rather than the 40 I’ve got in my coding(why is this?! – v frustrating!.
To get round this I’ve tried (unsuccessfully) experimenting with MultipleRanges and Union. The coding is below, please help. Cheers.

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("x519:x1518,ab519:ab1518,af519:af1518,aj519:aj1518,an519:an1518,ar519:ar1518,av519:av1518,az519:az1518,bd519:bd1518,bh519:bh1518,bl519:bl1518,bp519:bp1518,bt519:bt1518,bx519:bx1518,cb519:cb1518,cf519:cf1518,cj519:cj1518,cn519:cn1518,cr519:cr1518,cv519:cv1518,cz519:cz1518,dd519:dd1518,dh519:dh1518,dl519:dl1518,dp519:dp1518,dt519:dt1518,dx519:dx1518,eb519:eb1518,ef519:ef1518,ej519:ej1518,en519:en1518,er519:er1518,ev519:ev1518,ez519:ez1518,fd519:fd1518,fh519:fh1518,fl519:fl1518,fp519:fp1518,ft519:ft1518,fx519:fx1518")
   
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

        ' Display a message when one of the designated cells has been
        ' changed.
        ' Place your code here.
    If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    
    Range(Target.Address).Select
    Selection.Copy
    Range("x508").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
Range(Target.Address).Select
       
    End If

End Sub

[wallyeye]

A limitation of the Range property, you can only have 256 characters. You can split it up into multiple groups:

Public Sub Worksheet_Change(ByVal Target As Excel.Range)

    If Not Intersect(Range("x519:x1518,ab519:ab1518,af519:af1518,aj519:aj1518,an519:an1518,ar519:ar1518,av519:av1518,az519:az1518,bd519:bd1518,bh519:bh1518,bl519:bl1518,bp519:bp1518,bt519:bt1518,bx519:bx1518,cb519:cb1518,cf519:cf1518,cj519:cj1518,cn519:cn1518"), Target) Is Nothing _
    And Not Intersect(Range("cr519:cr1518,cv519:cv1518,cz519:cz1518,dd519:dd1518,dh519:dh1518,dl519:dl1518,dp519:dp1518,dt519:dt1518,dx519:dx1518,eb519:eb1518,ef519:ef1518,ej519:ej1518,en519:en1518,er519:er1518,ev519:ev1518,ez519:ez1518,fd519:fd1518,fh519:fh1518"), Target) Is Nothing _
    And Not Intersect(Range("fl519:fl1518,fp519:fp1518,ft519:ft1518,fx519:fx1518", Target)) Is Nothing Then

        If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub

        Range("x508") = Target.Value
        Target.Select

    End If

End Sub

I cut out some of the intermediate code as well, since you are pastingspecial to get target.value I just directly assigned target.value to range("x508").

[Leith Ross]

Hello owstie ,

Welcome to the Forum!

Using the Union method works for combining the ranges. In your macro I disable and enable the Application Events. This is important whenever you aare using Worksheet_Change or Worksheet_SelectionChange events. If you change or select a cell in theses events respectively then you will create a cascade event condition which will cause the stack to overflow. This will usually crash Excel.

It is rare in VBA that you will need to Select and object before performing an operation on it. Also, if you want to "copy" values, the easiest method is to assign the Value of source range to the destination range.

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("x519:x1518,ab519:ab1518,af519:af1518,aj519:aj1518,an519:an1518,ar519:ar1518,av519:av1518,az519:az1518")
        Set KeyCells = Union(KeyCells, Range("bd519:bd1518,bh519:bh1518,bl519:bl1518,bp519:bp1518,bt519:bt1518,bx519:bx1518,cb519:cb1518,cf519:cf1518"))
        Set KeyCells = Union(KeyCells, Range("cj519:cj1518,cn519:cn1518,cr519:cr1518,cv519:cv1518,cz519:cz1518,dd519:dd1518,dh519:dh1518,dl519:dl1518"))
        Set KeyCells = Union(KeyCells, Range("dp519:dp1518,dt519:dt1518,dx519:dx1518,eb519:eb1518,ef519:ef1518,ej519:ej1518,en519:en1518,er519:er1518"))
        Set KeyCells = Union(KeyCells, Range("ev519:ev1518,ez519:ez1518,fd519:fd1518,fh519:fh1518,fl519:fl1518,fp519:fp1518,ft519:ft1518 ,fx519:fx1518"))
    
        If Not Application.Intersect(KeyCells, Target) Is Nothing Then

        ' Display a message when one of the designated cells has been
        ' changed.
        ' Place your code here.
            If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
    
            Application.EnableEvents = False
                Range("x508").Value = Target.Value
            Application.EnableEvents = True
        End If

End Sub

[owstie]

Thank you very much gents. Superb help. Looking forward to being part of this forum.