PDA

View Full Version : date issue for excel file



klpw
01-20-2016, 10:43 PM
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
01-20-2016, 11:06 PM
What are you using

If .Column = Asc(TriggerColumn) - 64 Then
Instead of

IF .Column = 3 Then

klpw
01-20-2016, 11:17 PM
Hi SamT,

I've had the error as shown in screenshot.
15231

SamT
01-21-2016, 12:00 AM
'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
01-21-2016, 12:25 AM
Hi SamT,

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

GTO
01-21-2016, 02:58 AM
That is because you are trying to Offset one cell/row past the end of the sheet.

SamT
01-21-2016, 07:54 AM
:banghead: End(xlUp) :banghead: