Run Time error '91'

[pete4monc]

Hi guys
I have this code which automatically runs when a cell in column J is populated from a drop down box, which works fine.
But if I type anything in any of the adjacent cells or delete any text in any adjacent cells it comes up with a run time error and I am not sure if it is my code or just something simple (like me.....lol).
It never used to come up with this error until I put the code in?
Does anyone have an idea what this could be? Many Thanks.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim Rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("J:J"), Target)
xOffsetColumn = 11
If WorkRng = "COMPLETE" Then
    Application.EnableEvents = False
    For Each Rng In WorkRng
        If Not VBA.IsEmpty(Rng.Value) Then
            Rng.Offset(0, xOffsetColumn).Value = Now
        Else
            Rng.Offset(0, xOffsetColumn).ClearContents
        End If
    Next
    Application.EnableEvents = True
End If
End Sub

 

[Colo]

I guess that that error comes from the range named WorkRng is nothing.
If you use an event only for column J, your code can be more simple as follows.

Private Sub Worksheet_Change(ByVal Target As Range)
    Const xOffsetColumn As Integer = 11

    'Make this event available only user changes Column J
    If Target.Column <> 10 Then Exit Sub
    If Target.Count > 1 Then Exit Sub

    Application.EnableEvents = False
    Select Case Target.Value
    Case "COMPLETE"
        Target.Offset(, xOffsetColumn).Value = Now
    Case ""
        Target.Offset(, xOffsetColumn).ClearContents
    End Select
    Application.EnableEvents = True
End Sub

 

[Peter_SSs]

In case you may clear (or enter) a number of cells in column J at once, I would suggest the following modification so that it acts on all the relevant rows.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Changed As Range, cell As Range
    
    Const xOffsetColumn As Integer = 11

    Set Changed = Intersect(Target, Columns("J"))
    If Not Changed Is Nothing Then
      Application.EnableEvents = False
      For Each cell In Changed
        Select Case cell.Value
          Case "COMPLETE"
              cell.Offset(, xOffsetColumn).Value = Now
          Case ""
              cell.Offset(, xOffsetColumn).ClearContents
        End Select
      Next cell
      Application.EnableEvents = True
    End If
End Sub

 

[pete4monc]

I guess that that error comes from the range named WorkRng is nothing.
If you use an event only for column J, your code can be more simple as follows.

Private Sub Worksheet_Change(ByVal Target As Range)
    Const xOffsetColumn As Integer = 11

    'Make this event available only user changes Column J
    If Target.Column <> 10 Then Exit Sub
    If Target.Count > 1 Then Exit Sub

    Application.EnableEvents = False
    Select Case Target.Value
    Case "COMPLETE"
        Target.Offset(, xOffsetColumn).Value = Now
    Case ""
        Target.Offset(, xOffsetColumn).ClearContents
    End Select
    Application.EnableEvents = True
End Sub

@Colo
Thanks that works great. Sometimes we try to make things too complicated unnecessarily.....lol. Thank you!

 

[pete4monc]

In case you may clear (or enter) a number of cells in column J at once, I would suggest the following modification so that it acts on all the relevant rows.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Changed As Range, cell As Range
   
    Const xOffsetColumn As Integer = 11

    Set Changed = Intersect(Target, Columns("J"))
    If Not Changed Is Nothing Then
      Application.EnableEvents = False
      For Each cell In Changed
        Select Case cell.Value
          Case "COMPLETE"
              cell.Offset(, xOffsetColumn).Value = Now
          Case ""
              cell.Offset(, xOffsetColumn).ClearContents
        End Select
      Next cell
      Application.EnableEvents = True
    End If
End Sub

@Peter_SSs
Hi Peter, thanks for that, this works brilliant. Many thanks for yourhelp.

 

[Peter_SSs]

You're welcome. Thanks for the follow-up.