Runtime error 1004: Method 'Range' of object '_Worksheet' failed

[Phil Payne]

Hello,

I realise there are a number of posts on this topic and I have reviewed them but cannot find exactly what I am looking for.

I have a macro that works well until I extend its range at which time I get the error 1004. The code range goes out to column EN:EN but the problem occurs when I extend the range(s) to cover "EQ:EQ" see code below.

Private Sub Worksheet_Change(ByVal Target As Range)
' This code checks for a change of Status in the Status column and
'   on change fills the adjacent Cost cell with appropriate colour then
'   enters current date into the adjacent Date cell.
' The range covered extends from column ‘R’ (first Status column), to column ‘EN’ (last Status column).
' If adding columns adjust ranges accordingly!

   Dim rCell As Excel.Range
   Dim rCodes As Range
   Dim rRow As Range
'On Error Resume Next
   Dim vMatch


   Set rCodes = Range("E2:E12")

   If Not Intersect(Target, Range("R:R,U:U,X:X,AA:AA,AD:AD,AG:AG,AJ:AJ,AM:AM,AP:AP,AS:AS,AV:AV,AY:AY,BB:BB,BE:BE,BH:BH,BK:BK,BN:BN,Bq:Bq,BT:BT,BW:BW,BZ:BZ,CC:CC,CF:CF,CI:CI,CL:CL,CO:CO,CR:CR,CU:CU,CX:CX,DA:DA,DD:DD,DG:DG,DJ:DJ,DM:DM,DP:DP,DS:DS,DV:DV,DY:DY,EB:EB,EE:EE,EH:EH,EK:EK,en:en")) Is Nothing Then

      For Each rCell In Intersect(Target, Range("R:R,U:U,X:X,AA:AA,AD:AD,AG:AG,AJ:AJ,AM:AM,AP:AP,AS:AS,AV:AV,AY:AY,BB:BB,BE:BE,BH:BH,BK:BK,BN:BN,Bq:Bq,BT:BT,BW:BW,BZ:BZ,CC:CC,CF:CF,CI:CI,CL:CL,CO:CO,CR:CR,CU:CU,CX:CX,DA:DA,DD:DD,DG:DG,DJ:DJ,DM:DM,DP:DP,DS:DS,DV:DV,DY:DY,EB:EB,EE:EE,EH:EH,EK:EK,en:en")).Cells

            If Len(rCell.Value) > 0 Then

               vMatch = Application.Match(rCell.Value, rCodes, 0)

               If IsError(vMatch) Then

                  MsgBox "Invalid code selected"

               Else

                  rCell.Offset(, 1).Interior.Color = rCodes.Cells(vMatch).Interior.Color
                  rCell.Offset(0, 2).Value = Date
               End If

            End If

      Next rCell

   End If
End sub

Does anyone know if there is a better / alternative way of doing this that will allow me to extend the range without the error?

Thanks.

[Norie]

Why not use something like this to check if Target is in the range?

If Target.Column>=Range("R1").Column And Target.Column<=Range("EN1").Column And Target.Column Mod 3 = 0 Then

This first checks if Target is within the overall range R:EN and then checks if it's the 3rd column.

[protonLeah]

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Dim rCell As Range
    Dim rCodes As Range
    Dim rRow As Range
    Dim vMatch
    
    Set rCodes = Range("E2:E12")
    
    If (Target.Column >= 18) And (Target.Column <= Range("EQ1").Column) And (Target.Column Mod 3 = 0) Then
        If Len(Target.Value) > 0 Then
            On Error Resume Next
            vMatch = Application.Match(Target.Value, rCodes, 0)
            If IsError(vMatch) Then
                MsgBox "Invalid code selected"
            Else
                With Target
                    .Offset(, 1).Interior.Color = rCodes.Cells(vMatch).Interior.Color
                    .Offset(0, 2).Value = Date
                End With
            End If
        End If
    End If
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

[Phil Payne]

Excellent.

Thank you protont (and Norrie) it worked perfectly.

Thanks again.