Getting run-time errors on code that auto-inserts dates

[achbaa]

Hi all! I'm very new to Excel VBA, and needed to implement a functionality into my sheet that would

• automatically insert a date into column W when any new value was added to column C
• automatically insert a date into column X when a value in column K is changed to "Payment Done", but only then and never in any other cases

I have put together the following piece of code from the excerpts I have found online. However, every time I try to delete any value (cells, rows, columns, etc.) I get a run-time error 13. This is highly problematic, as I'll often need to delete some values.

Can anyone please help identify what's wrong with the code below and how to fix it? I tried googling extensively but to no avail...

Thanks a ton!

Private Sub Worksheet_Change(ByVal Target As Range)

'Update 20140722

Dim WorkRng As Range

Dim Rng As Range

Dim xOffsetColumn As Integer

Set WorkRng = Intersect(Application.ActiveSheet.Range("C:C"), Target)

xOffsetColumn = 20

If Not WorkRng Is Nothing Then

Application.EnableEvents = False

For Each Rng In WorkRng

If Not VBA.IsEmpty(Rng.Value) Then

Rng.Offset(0, xOffsetColumn).Value = Now

Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mmm-yy"

Else

Rng.Offset(0, xOffsetColumn).ClearContents

End If

Next

Application.EnableEvents = True

End If

If Target.Column = 11 And Target.Value = "Payment Done" And Target.Offset(0, 13).Value = "" Then

Target.Offset(0, 13) = Format(Now(), "dd-mmm-yy")

End If

End Sub

 

[rlv01]

If you are ok with only changing one cell at a time (as opposed to pasting values en-masse) then this should help:

Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
    Dim WorkRng As Range
    Dim Rng As Range
    Dim xOffsetColumn As Integer

    If Target.Cells.Count = 1 Then
        Set WorkRng = Intersect(Application.ActiveSheet.Range("C:C"), Target)
        xOffsetColumn = 20
        If Not WorkRng Is Nothing Then
            Application.EnableEvents = False
            For Each Rng In WorkRng
                If Not VBA.IsEmpty(Rng.Value) Then
                    Rng.Offset(0, xOffsetColumn).Value = Now
                    Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mmm-yy"
                Else
                    Rng.Offset(0, xOffsetColumn).ClearContents
                End If
            Next
            Application.EnableEvents = True
        End If
        If Target.Column = 11 And Target.Value = "Payment Done" And Target.Offset(0, 13).Value = "" Then
            Target.Offset(0, 13) = Format(Now(), "dd-mmm-yy")
        End If
    End If
End Sub

 

[rollis13]

Hi to all.
I'm late but I was going to suggest this change since you probably never delete the entire column C. And also, manage the function EnableEvents on this part of the macro too, to avoid redundant triggering of the macro.

    '...
    End If
    If Target.Cells.CountLarge > 1 Then Exit Sub '<- added
    Application.EnableEvents = False '<- added
    If Target.Column = 11 And Target.Value = "Payment Done" And Target.Offset(0, 13).Value = "" Then Target.Offset(0, 13) = Format(Now(), "dd-mmm-yy")
    Application.EnableEvents = True '<- added
End Sub

 

[achbaa]

If you are ok with only changing one cell at a time (as opposed to pasting values en-masse) then this should help:

Private Sub Worksheet_Change(ByVal Target As Range)
'Update 20140722
    Dim WorkRng As Range
    Dim Rng As Range
    Dim xOffsetColumn As Integer

    If Target.Cells.Count = 1 Then
        Set WorkRng = Intersect(Application.ActiveSheet.Range("C:C"), Target)
        xOffsetColumn = 20
        If Not WorkRng Is Nothing Then
            Application.EnableEvents = False
            For Each Rng In WorkRng
                If Not VBA.IsEmpty(Rng.Value) Then
                    Rng.Offset(0, xOffsetColumn).Value = Now
                    Rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mmm-yy"
                Else
                    Rng.Offset(0, xOffsetColumn).ClearContents
                End If
            Next
            Application.EnableEvents = True
        End If
        If Target.Column = 11 And Target.Value = "Payment Done" And Target.Offset(0, 13).Value = "" Then
            Target.Offset(0, 13) = Format(Now(), "dd-mmm-yy")
        End If
    End If
End Sub

Thanks a lot for this! I understand that this would not work if my teammates paste in 10-15 rows at the same time? Is there a work around for such cases, cause they very rarely paste them one by one, and never actually type them in manually.

 

[achbaa]

Hi to all.
I'm late but I was going to suggest this change since you probably never delete the entire column C. And also, manage the function EnableEvents on this part of the macro too, to avoid redundant triggering of the macro.

    '...
    End If
    If Target.Cells.CountLarge > 1 Then Exit Sub '<- added
    Application.EnableEvents = False '<- added
    If Target.Column = 11 And Target.Value = "Payment Done" And Target.Offset(0, 13).Value = "" Then Target.Offset(0, 13) = Format(Now(), "dd-mmm-yy")
    Application.EnableEvents = True '<- added
End Sub

This seems to work perfectly (and you're exactly right that I will not be deleting column C entirely). Thanks a lot for this!

 

[rollis13]

Thanks for the positive feedback, glad we were able to help.