CODEWITHSUNDEEP
excelvba
belau
belau

Reputation: 15

Auto-fill the date in a cell, when change is made into an adjacent cell

I found code to work in Excel that almost does what I need.

My need is to have today's date added automatically in one column's cell when a change is made in another column's cell. So if I click in Column M Row 20's cell & change data or add data (in this case it is a Status column with a dropdown list) then in Column N Row 20's cell it will put today's date or replace old date with today's date. (Every time Status dropdown is changed.)

This code does that for 2 different columns because I altered it.

The Problems:

  1. If I insert rows it will put today's date in the newly inserted rows or if I delete rows, let's say 3 rows it will add the date or overwrite the date in the 3 rows below the 3 just deleted. This is not good. I only want a date added if I make a change in the cell itself. Simply auto add date when we add or change the status (Data) in the cell to the left of it.

  2. Also I need the top 9 rows not to be affected by this auto date add.

  3. Lastly if I double click in Column M Row 20's cell but do not enter any data then click out of the cell it will still add date to Column N Row 20's cell.

I found the original code at: Auto-fill the date in a cell, when the user enters information in an adjacent cell

My version of the code is:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, M As Range, X As Range, Inte As Range, r As Range
Set A = Range("M:M,X:X")
Set Inte = Intersect(A, Target)
If Inte Is Nothing Then Exit Sub
Application.EnableEvents = False
    For Each r In Inte
        r.Offset(0, 1).Value = Date
    Next r
Application.EnableEvents = True
End Sub

Upvotes: 1

Views: 3794

Answers (1)

user4039065
user4039065

Reputation:

These modification take care of your first two specifications.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("M:M,X:X"), Range("10:" & Rows.Count)) Is Nothing Then
        If Target.Count < Columns.Count Then
            On Error GoTo bm_Safe_Exit
            Application.EnableEvents = False
            Dim r As Range
            For Each r In Intersect(Target, Range("M:M,X:X"), Range("10:" & Rows.Count))
                With r.Offset(0, 1)
                    .Value = Now   'use Now to retain the time as well as the date
                    .NumberFormat = "dd-mmm-yyyy hh:mm:ss"  'change to what you prefer
                End With
            Next r
        End If
    End If
bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

As far as the third, I would humbly suggest that you get used to using the preferred method of tapping Esc to abandon an 'in-cell' edit rather than Enter↵ or selecting another cell. Using Esc does not change the value in the cell and the Worksheet_Change event macro is not triggered. Using Enter or selecting another cell DOES change the value in the cell and coding against lackadaisical practises is simply not worth the overhead when proper keyboard practises could be applied.

Addendum:

If your hand is still on the mouse, you can also click the × in the formula bar to [Esc] an in-cell edit.

        in-cell-edit_escape

Upvotes: 3

Related Questions