date issue for excel file

[klpw]

Hi guys,

I'm currently having issue with my Excel vba code. When new data entry is added in Sheet1, it will show new on column B and will automatically copy and paste data in Sheet2 with today's date. In my case, it doesn't show today's date for new entries in Sheet2. Also, tomorrow I want to clear all the New for yesterday and show New on column B for any added data entry tomorrow in Sheet1 and yesterday's date become all clear and show today's date for new data entry in Sheet2. May I know how can I change my code to achieve this as shown in the picture? My code is as below:

In Module1:

Sub Run()
Dim lastRow As Long
Dim y As Worksheet
Dim t As Worksheet
'lastRow = Sheets("y").Range("A100000").End(xlUp).Row + 1 ' then next free row in sheet2
Sheets("Sheet1").Range("C:V").Copy Destination:=Sheets("Sheet2").Range("C:V")
End Sub

Public Sub CreationDate(ByRef Target As Range)
   
    Const CreateColumn As String = "B"
   
    With Target
        With .Worksheet.Cells(.Row, CreateColumn)
            If Not IsDate(.Value) Then .Value = Date
            .Offset(0, 1).Select
        End With
    End With
End Sub

In Sheet1

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim C As Range, B As Range, Inte As Range, r As Range, myvalue As String
    Set C = Range("C:C")
    Set Inte = Intersect(C, Target)
    myvalue = "New"
    If Inte Is Nothing Then Exit Sub
    Application.EnableEvents = False
        For Each r In Inte
            r.Offset(0, -1).Value = myvalue
        Next r
    Application.EnableEvents = True
    Sheets("Sheet1").Range("C:V").Copy Destination:=Sheets("Sheet2").Range("C:V")
End Sub

In Sheet2

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const TriggerColumn As String = "C"
    Const HeaderRows As Long = 1
   
    With Target
        If .Column = Asc(TriggerColumn) - 64 Then
            If .Row > HeaderRows And _
                Trim(.Value) <> vbNullString Then _
                CreationDate Target
        End If
    End With
End Sub

In ThisWorkbook

Private Sub Workbook_Open()
Sheets("Sheet1").Range("A1").Value = Format(Date, ("dd/mm/yyyy"))
Sheets("Sheet2").Range("A1").Value = Date - 1
If Sheets("Sheet1").Range("B:B").Text = "New" Then
Sheets("Sheet2").Range("B:B").Value = Date
Save
End If
End Sub

[SamT]

What are you using

 If .Column = Asc(TriggerColumn) - 64 Then

Instead of

 
IF .Column = 3 Then

[klpw]

Hi SamT,

I've had the error as shown in screenshot.
error code.jpg

[SamT]

'All Sheets' Code
Option Explicit

'This Workbook Code
Private Sub Workbook_Open()
SetDates
End Sub

Private Sub SetDates()
    Sheets("Sheet1").Range("A1").Value = Format(Date, "dd/mm/yyyy")
    Sheets("Sheet2").Range("A1").Value = Format(Date - 1, "dd/mm/yyyy")
End Sub

'Sheet1 Code
Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Columns(3), Target) Is Nothing Then CopyPaste Target
End Sub

Private Sub CopyPaste(Target)
    Dim NextPasteCell As Range, NewRows As Range
    
    Set NewRows = Intersect(Columns(3), Target).Offset(0, -1)
    Application.EnableEvents = False
   
    NewRows = Date 'NewRows is not Column B of the New Dat
    
    With Sheets("Sheet2")
      NextPasteCell = .Cells(Rows.Count, 2).Offset(1)
      .Range("B:B").ClearContents
    End With
    
    NewRows.Rsize(NewRows.Cells.Count, (Columns("V").Column - NewRows.Coumn) + 1).Copy NextPasteCell
    NewRows = "New"
    
    Application.EnableEvents = True

End Sub

[klpw]

Hi SamT,

I've got the error of below after running.
error.jpg

[GTO]

That is because you are trying to Offset one cell/row past the end of the sheet.

[SamT]

End(xlUp)