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

Answer 1

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

Answer 2

please try this code

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

and should be called like

MyToday()

Answer 3

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

Answer 4

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

Answer 5

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

Answer 6

Range("L8").Formula = "=IF(AND(F5="",G5="",H5=""),"",I4+F5-G5-H5)" 我试过了，但没有出现