VBA Worksheet_change when a new row has been added, insert today's date

Question

i tried to use the formula =Today() on the table of my database and when i try to insert a new row the next day, the whole data even the previous dates had been replace with the current day's date. Is there anyway to prevent it ? Or is it possible to use worksheet_change to update the date's column when new row had been inserted and the new role's date column will have the current day date and the following day when i update again it wont be replaced? Please advise thanks

Every time your sheet gets updated, every single value will be set to the current date because every row gets updated. You should try to write a macro for this, which updates the whole sheet but only changes the value currently added. — Thomas, May 19 '17 at 05:45
Another suggestion, before adding that new row in the next day, why you are not Pasting the Value of yesterday's date? **(Simply copy and paste values)** As long as you don't want that date to be changed, you should rescue it from `=Today()` formula to prevent it from changing. — Mertinc, May 19 '17 at 05:54
You are not expecting an answer like press **CTRL + ;** button, are you? — Romcel Geluz, May 19 '17 at 06:00
@Mertinc oh good idea, i can have a today's date in my form and when it get's saved i can copy and paste values to the database.. Great idea man. But was wondering if WorkSheet_change can be included instead of doing the copy and pasting — ZQ7, May 19 '17 at 06:01
@RomcelGeluz yo Romcel! great to see you again. Of course not that xD i wanted something like a macro that is able to record todays date when the row is inputted. something about worksheet_change if i can remember clearly — ZQ7, May 19 '17 at 06:02
I added the copy and paste values answer below ZQ7, as I don't know the structure and layout of your worksbook, I didn't understand clearly whay you would like to do with `Worksheet_Change` event. — Mertinc, May 19 '17 at 06:24

score 1 · Answer 1 · edited May 23 '17 at 12:18

From Determine whether user is adding or deleting rows by breetdj I write this code. Try to put it in the sheet module:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Static LR As Long
Dim Table as range
Set Table = Me.ListObjects(1).DataBodyRange
If LR = 0 Then
    LR = Table.Rows.Count
    Exit Sub
End If
If Table.Rows.Count < LR Or Table.Cells(Table.Rows.Count, 1) <> "" Then Exit Sub
Table.Cells(Table.Rows.Count, 1) = Date
LR = LR + 1
End Sub

Change "ListObjects(1)" with the name of the table, and change the column number with your desired column

score 0 · Answer 2 · answered May 19 '17 at 06:09

0

please try this code

Public Function MyToday() As Date
MyToday = CDate(Now() \ 1)
End Function

and should be called like

MyToday()

answered May 19 '17 at 06:09

Romcel Geluz

583
2
10

1

You can achieve the same effect as `MyToday()` by just saying `Date()` (the VBA function that returns today's date) without the need for an extra function. – YowE3K May 19 '17 at 08:21

Mertinc · Accepted Answer · 2017-05-19T07:35:51.203

ZQ7, this answer is as I mentioned in the comments, finds the =TODAY() formula cell and paste it's values to it's current cell. Then you can add your new row and run the rest of your code..

Option Explicit

Sub prevenddate()
Dim mert As Range
Dim wb As Workbook
Dim ws As Worksheet

Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
    Cells.Find(What:="=TODAY()", After:= _
        ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Copy
ActiveCell.PasteSpecial xlPasteValues

End Sub

And here is the desired answer!

This below code, firstly looks for any =TODAY() formula in worksheet, and if the result is today's date it doesn't do anything. But if it's different then today's date then it simply does Paste Values

Private Sub Worksheet_Change(ByVal Target As Range)

Dim wb As Workbook
Dim ws As Worksheet
Dim myRw As Long, myCl As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet1")
On Error GoTo 10

myRw = ActiveCell.Row
myCl = ActiveCell.Column

        ws.Cells.Find(What:="=TODAY()", After:= _
        ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Activate
  If ActiveCell.Value <> Date Then

        Cells.Find(What:="=TODAY()", After:= _
        ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Copy
ActiveCell.PasteSpecial xlPasteValues
  Else
End If
10
  ws.Cells(myRw, myCl).Offset(-1, 0).Activate
Application.CutCopyMode = False
End Sub

But is it possible to change it into worksheet_change instead of activating the macro manually? — ZQ7, May 19 '17 at 06:25
Ah now I got what you mean. But when (after which change) you would like macro to run (in which condition)? — Mertinc, May 19 '17 at 06:26
well i was wishing for a more automated one. But it's okay i think your macro works just as well. Thanks a lot man! — ZQ7, May 19 '17 at 06:34
I will add your requested feature very soon mate don't worry, wait on the line! — Mertinc, May 19 '17 at 06:40
@ZQ7 please see my edited answer above. I've created a `Worksheet_Change` event, firstly looks for any `=TODAY()` formula in worksheet, and if the result is **today's date** it doesn't do anything. But if it's different then *today's date* then it simply does `Paste Values` — Mertinc, May 19 '17 at 07:37

score 0 · Answer 4 · answered May 19 '17 at 06:34

Place the following code on Sheet Module.

The code will insert a Date in column A if you input something in column B starting from Row2.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long
On Error GoTo SkipError
If Target.Column = 2 And Target.Row > 1 Then
    Application.EnableEvents = False
    r = Target.Row
    If Target <> "" Then
        If Cells(r, "A") = "" Then
            Cells(r, "A") = Date
        End If
    Else
        Cells(r, "A") = ""
    End If
End If
SkipError:
Application.EnableEvents = True
End Sub

score -1 · Answer 5 · edited Dec 08 '20 at 10:27

-1

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 'Dim Rg As Range
 'Dim G As Integer
 'Dim varno As Long
  With Sheet1
  Range("J5:J5").AutoFill Destination:=Range("j5:j218")
 
 'Range("L8").Formula = "=IF(AND(F5="",G5="",H5=""),"",I4+F5-G5-H5)"
 

'Range("L8").Formula = ""

End With
End Sub

edited Dec 08 '20 at 10:27

Donald Duck

8,409
22
75
99

answered Dec 08 '20 at 06:06

karmu singh

1

1

While this code may answer the question, providing additional context regarding how and/or why it solves the problem would improve the answer's long-term value. – Donald Duck Dec 08 '20 at 10:27

score -1 · Answer 6 · answered Dec 09 '20 at 05:43

-1

Range("L8").Formula = "=IF(AND(F5="",G5="",H5=""),"",I4+F5-G5-H5)" i try but it does not appear

answered Dec 09 '20 at 05:43

karmu singh

1

VBA Worksheet_change when a new row has been added, insert today's date

6 Answers6

And here is the desired answer!