Auto-fill date based on value

Question

What the code does:

Enter a name in column C, date populates in column K.

Other:

1. Drop down in column J can be "registered" or "locked"
2. When data is entered in column C it auto populates "registered" in column J

Here is the code:

'Adds date when borrower name is entered
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim A As Range, B As Range, Inte As Range, r As Range
    Set A = Range("C:C")
    Set Inte = Intersect(A, Target)
    If Inte Is Nothing Then Exit Sub
    Application.EnableEvents = False
        For Each r In Inte
            If r.Offset(0, 8).Value = "" Then
               r.Offset(0, 8).Value = Date
            End If
        Next r
    Application.EnableEvents = True
End Sub

I got this code from: Auto-fill the date in a cell, when the user enters information in an adjacent cell

What I would like the code to do:

If column J is "registered" add date to column K (Which is currently does)

If column J is changed to "locked", add date to column L

Answer 1

Resize the destination to two columns wide and add 'Registered" along with the date.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Columns(3), Target) Is Nothing Then
        On Error GoTo bm_SafeExit
        Application.EnableEvents = False
        Dim C As Range
        For Each C In Intersect(Columns(3), Target, Target.Parent.UsedRange)
            If IsEmpty(C.Offset(0, 8)) Then
               C.Offset(0, 7).Resize(1, 2) = Array("registered", Date)
            End If
        Next C
    End If
bm_SafeExit:
    Application.EnableEvents = True
End Sub

I've found that if you are going to process multiple Target cells (e.g. from a paste operation) then the loop through the Intersect of Target and your predetermined column should also be pared down to the extents of the Worksheet.UsedRange property. Without it, a large number of blank cells would be looped through on a full column paste operation.