The following is running.
If I would like a time and date stamp created in column B when a value is insterted into column A, how can I modify the existing module?
(I couldn't paste the code, that's why there is a link)
Log Value in Excel
It's just a small change to that line:
Worksheets("Sheet2").Range("a" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Resize(, 2).Value = Array(Range("E15").Value, Now())
Edit: I'm not sure why you have changed your question to remove the code you posted originally!?
The below code will check if there any changes in the last line sheet2,
the time stamp will be printed in the Column B
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Worksheets("sheet2").Range("A" & Cells(Rows.Count).Row).End(xlUp)) Is Nothing Then
lastrow = Worksheets("sheet2").Cells(Worksheets("sheet2").Rows.Count, "A").End(xlUp).Row
Worksheets("sheet2").Cells(lastrow, 2).Value = Now()
End If
End Sub
Related
I have programmed a manual macro in Excel VBA that displays 2 or in the future multiple tables to show the history of certain data in a sheet called "evaluation". The data i reference to is in the table "checklist".(Look below) The problem is that the data in "checklist" changes every day or more often. Every time the sheet changes the macro should insert a new row with a new date into the LastRow of the table in "evaluation". I would like to display a history of the data in "evaluation". So the values in the row of the last change should stay stable. So for example row 1 in "evaluation": 2020-01-17 value is 1 (this should stay 1, because i want to see the progress) Now the sheet changes and row 2 gets inserted: row 2: 2020-01-18 value is now 2 (copied from checklist) and i want the value in row 1 to stay at 1 (because it was 1 before the last change).
This part works perfectly with my 1st code: (see below), but if I want to record the data of the second table too (code 2) nothing happens... Do I have to just make an adjustment to my first code or how is it done? Right now it looks like this:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)
If Sh.Name = "checklist" Then
'Monitoring from A3:E100, if different change this
If Not Intersect(target, Range("A3:E3")) Is Nothing Then
'if any monitoring here, please you add here
Test target 'Here procedure to insert
End If
End If
End Sub
Private Sub Test(target As Range)
Dim LastRow As Long
LastRow = Range("evaluation!A" & Sheets("evaluation").Rows.Count).End(xlUp).Row
If Range("evaluation!A1").Value <> "" Then
LastRow = LastRow + 1
End If
'every change A3:E in checklist will insert row to this evaluation
'but if different please you decide here
Range("evaluation!A" & LastRow).Value = Format(Now, "dd.mm.yyyy hh:mm") 'you can change this
Range("evaluation!B" & LastRow & ":F" & LastRow).Value = Range("checklist!A" & target.Row & ":E" & target.Row).Value
End Sub
the first codes are for the first table and the one below is for the second table:
Private Sub Workbook_SheetChange2(ByVal Sh As Object, ByVal target As Range)
If Sh.Name = "checklist" Then
'Monitoring from A3:E100, if different change this
If Not Intersect(target, Range("G3:K3")) Is Nothing Then
'if any monitoring here, please you add here
Test target 'Here procedure to insert
End If
End If
End Sub
Private Sub Test2(target As Range)
Dim LastRow As Long
LastRow = Range("evaluation!H" & Sheets("evaluation").Rows.Count).End(xlUp).Row
If Range("evaluation!H1").Value <> "" Then
LastRow = LastRow + 1
End If
'every change A3:E in checklist will insert row to this evaluation
'but if different please you decide here
Range("evaluation!H" & LastRow).Value = Format(Now, "dd.mm.yyyy hh:mm") 'you can change this
Range("evaluation!I" & LastRow & ":M" & LastRow).Value = Range("checklist!G" & target.Row & ":K" & target.Row).Value
End Sub
Do you have any ideas how to connect these codes? Sorry I am not really a VBA expert. I made a google sheet to show what I actually mean, but I need this in excel VBA, the google sheet is just to visualize what I mean: https://docs.google.com/spreadsheets/d/1OU_95Lhf6p0ju2TLlz8xmTegHpzTYu4DW0_X57mObBc/edit#gid=0
I think you just forgot to add a "2". For your second code, it still calls Test instead of calling Test2.
I'll be happy to dig in, if that isn't the error. But since the first one works for you, the second should work too. Lets hope.
Edit after OPs comment:
I meant you called the sub "Test" twice and never actually called Test2 (also I didnt see the 2 on your second sheetchange).
Just merge the two SheetChanges and correctly call the TestX subs.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal target As Range)
If Sh.Name = "checklist" Then
'Monitoring from A3:E100, if different change this
If Not Intersect(target, Range("A3:E3")) Is Nothing Then
'if any monitoring here, please you add here
Test target 'Here procedure to insert
End If
If Not Intersect(target, Range("G3:K3")) Is Nothing Then
'if any monitoring here, please you add here
Test2 target 'Here procedure to insert
End If
End If
End Sub
This is my approach
Convert ranges to Excel Tables
Put the code behind checklist sheet
Checklist sheet
Table name in that sheet: TableCheckList
Evaluation sheet
Table names in that sheet TableHistory01 and TableHistory02
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim checkListTable As ListObject
Dim checkListRow As ListRow
Set checkListTable = Range("TableCheckList").ListObject
If Intersect(Target, checkListTable.DataBodyRange) Is Nothing Then Exit Sub
Set checkListRow = checkListTable.ListRows(Target.Row - checkListTable.HeaderRowRange.Row)
AddHistory Target, "TableHistory01", checkListRow
AddHistory Target, "TableHistory02", checkListRow
End Sub
Private Sub AddHistory(ByVal Target As Range, ByVal HistoryTableName As String, ByVal checkListRow As ListRow)
Dim historyTable As ListObject
Dim newRow As ListRow
Set historyTable = ThisWorkbook.Worksheets("Evaluation").ListObjects(HistoryTableName)
' Add a row to that table
Set newRow = historyTable.ListRows.Add(alwaysInsert:=True)
' Fill the row with source values
With newRow
.Range.Cells(1).Value = Format(Now, "dd.mm.yyyy hh:mm")
.Range.Cells(2).Value = checkListRow.Range.Cells(1)
.Range.Cells(3).Value = checkListRow.Range.Cells(2)
.Range.Cells(4).Value = checkListRow.Range.Cells(3)
.Range.Cells(5).Value = checkListRow.Range.Cells(4)
.Range.Cells(6).Value = checkListRow.Range.Cells(5)
End With
End Sub
Some remarks:
Your code is adding rows everytime a cell is changed. Is that the intended purpose? Maybe when a row in checklist is changed/added?
You mentioned to record days, but your code is adding the time too
Here is a link to the sample
Some reference to about to listobjects (Excel tables)
Let me know if it works
I'm working on a planning monitoring tool. I need to lock a range of cells based on a cell value.
I would like when the value in column "Q" is "Confirmed", then cells on the same row from Column M to Q are locked.
Sub planning_blocker()
Dim last_row As Integer
' Compute the last row
last_row = Worksheets("Planning").Cells(Rows.Count, 1).End(xlUp).Row
Debug.Print last_row
For i = 3 To last_row
If Worksheets("Planning").Cells(i, 17).Value = "" Then
Sheets("Planning").Range("M" & i & ":" & "P" & i).Locked = False
Else
Sheets("Planning").Range("M" & i & ":" & "P" & i).Locked = True
End If
Next i
Sheets("Planning").Protect Password:="User"
End Sub
This works partially because:
it locks the entire row where "confirmed" is detected and not only the range
it consider only the first row where "confirmed" is detected and not the remaining ones (if more than one row is marked with "confirmed", only the first row is blocked).
i tested your code and it works for me (Excel2016). the ranges (M:P) are locked if 17th column (col Q) of current row isn't empty. don't no what could be your problem here...
Well, if you need to watch the status column for changes, I would suggest to use the Sub Worksheet_Change. this will trigger your code every time something changes in your sheet.
I made some changes to adapt your code and here is the result:
Sub Worksheet_Change(ByVal target As Range)
Dim intesection As Range
Dim rowIndex As Integer
Set intesection = Intersect(target, Range("Q:Q"))
'watch changes in intersection (column Q)
If Not intesection Is Nothing Then
'get row index of changed status
rowIndex = Range(intesection.Address(0, 0)).Row
If Cells(rowIndex, 17).Value = "" Then
'unlock if status is blank
ActiveSheet.Range("M" & rowIndex & ":" & "P" & rowIndex).Locked = False
Call ActiveSheet.Protect(UserInterfaceOnly:=True, Password:="User")
Else
'lock if not blank
ActiveSheet.Range("M" & rowIndex & ":" & "P" & rowIndex).Locked = True
Call ActiveSheet.Protect(UserInterfaceOnly:=True, Password:="User")
End If
End If
End Sub
And you need to add this to the sheet where you have the table you want to lock/unlock.
Something like this:
Sources:
How to Lock the data in a cell
How to Tell if a Cell Changed
I have a cell that states the status of a project, and this status will change frequently.
Whenever the status gets changed, I would like a row to state the time the status was changed and the name of the new status.
I have next to no experience with VBA, so any assistance would be greatly appreciated. So far I have this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 And Target.Row = 4 Then
Target.Offset(10, 3) = Format(Now(), "YYYY-MM-DD HH:MM:SS")
End If
End Sub
This code successfully lists the time in cell G7 whenever the status contained in cell D4 changes, but it always repopulates the same cell, I would like each successive status change to list the date stamp in cell G8, then G9, then G10, and so on.
It also doesn't list what the status cell D4 is changed too, ideally I would like that to be listed in F7, then F8, then F9, and so on.
If you are only interested in a Worksheet_Change on cell D4, you can use the Intersect method shown below
To start a running list, you will need to determine that last used cell in Column G and offset accordingly
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D4")) Is Nothing Then
Dim LR As Long: LR = Range("G" & Rows.Count).End(xlUp).Offset(1).Row
Target.Offset(LR - Target.Row, 3) = Format(Now(), "YYYY-MM-DD HH:MM:SS")
Target.Offset(LR - Target.Row, 4) = Target
End If
End Sub
Please try this.
Private Sub Worksheet_Change(ByVal Target As Range)
Const Tgt As String = "D4" ' monitored cell
Const FirstRecord As Long = 7 ' change as required
Const Fmt As String = "yyyy-mm-dd hh:mm:ss"
Dim Rl As Long ' last used row
If Target.Address = Range(Tgt).Address Then
Application.EnableEvents = False
Rl = Application.WorksheetFunction.Max( _
Cells(Rows.Count, "F").End(xlUp).Row + 1, FirstRecord)
With Cells(Rl, "G")
.Value = Now()
.NumberFormat = Fmt
Target.Copy Destination:=.Offset(0, -1)
End With
Application.EnableEvents = True
End If
End Sub
I need to create a timestamp log of changes to a cell. For example if cell D1's value changes from previous value Column A will log the timestamp.
private sub worksheet_change(ByVal Target as Range)
if Range("d1") then
applicaton.enableevents = false
range("a1") = DATE + Time
applicaton.enableevents = true
end if
End sub
This is what I have so far, this logs the changes to D1 but it doesn't populate the next row of column A with a timestamp, it just modifies cell A1 with the current timestamp. I need to track the changes with a new entry of timestamp. I need it to populate the entire column A with timestamp every time there is a change to cell D1.
A solution:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$1" Then
Application.EnableEvents = False
Dim LastRow As Long, ws As Worksheet
Set ws = Target.Worksheet
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
ws.Range(ws.Cells(LastRow + 1, 1), ws.Cells(LastRow + 1, 1)).Value = DateValue(Now()) & ", " & TimeValue(Now())
Application.EnableEvents = True
End If
End Sub
Notes:
It is important to fully qualify ranges.
Finding the last row might be tricky in some cases. See this. I assume you do not have one such case.
That's already a good start point. Now you need only to make sure the modification time is appended at the end of the last log registered in column A. I think replacing this line:
range("a1") = DATE + Time
with this line
Cells(Rows.Count, 1).End(xlUp).offset(1,0) = "D1 Modified on " & DateSerial(Year(Now()),Month(Now()),Day(Now())) & " at " & TimeSerial(Hour(Now()), Minute(Now()), Second(Now()))
should do the trick for what you want.
I Have a table that is set out with these headers:
Task ID | Description | Date completed | Time completed
Let say that the table is set out so that Task ID is in cell A3, Description B3, Date Completed C3, and Time Completed D3. In cell A1 I will input the Task ID to be looked up.
What I would like to happen is that when the macro is run, the Task ID entered into cell A1 is found in the table and then the date and time (at the time of running the Macro) are entered into the corresponding cells in columns C and D.
Thanks!
It sounds like you just need a bunch of VLOOKUPS. In cell A1 enter your task ID. In cell A2 enter a VLOOKUP for the description (Assuming you have 100 Ids)
=VLOOKUP($A$1,$A$4:$D$100,2,FALSE)
and in A3 for the Date etc
=VLOOKUP($A$1,$A$4:$D$100,3,FALSE)
The following two procedures represent one way to do what you are interested in. The first uses the FIND function to locate the task ID in your table that matches the contents of cell A1; the second runs the first procedure whenever you make an entry in A1.
Date and time logging code
You will need to paste this code into a standard VBA module in the workbook. A standard code module can be inserted by selecting Visual Basic from the Developer tab of the ribbon, and then choosing Insert, Module on the main menu of the VBA code editor.
Note that the procedure assumes that the task table is in Sheet1 of the workbook. If it is in another sheet, you will need to change the name "Sheet1" in the code to the correct name.
Sub LogTaskCompletion()
Dim lastRow As Long
Dim foundCell As Range
With ThisWorkbook.Sheets("Sheet1") '<-- change sheet name here
If Not .Range("A1").Value = "" Then
lastRow = .Range("A" & Rows.Count).End(xlUp).Row
'do the search
Set foundCell = .Range("A2:A" & lastRow).Find(What:=.Range("A1").Value, _
LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)
If Not foundCell Is Nothing Then
'a match! post the date and time for the task
With foundCell
.Offset(0, 2).Value = Date
.Offset(0, 2).NumberFormat = "mm-dd-yyyy"
.Offset(0, 3).Value = TimeValue(Now())
.Offset(0, 3).NumberFormat = "hh:mm am/pm"
End With
Else
'no match!
MsgBox "Cannot find task " & .Range("A1").Value
End If
.Range("A1").ClearContents
End If
End With
End Sub
Macro trigger code
This procedure will run the preceding macro whenever an entry is made in A1.
It needs to be installed as code private to the worksheet the task table is in. The easiest way to do this is to right-click on the worksheet's tab, select View Code, and then paste the code into the editor pane that pops up.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1")) Is Nothing Then
Exit Sub
End If
Application.EnableEvents = False
LogTaskCompletion
Application.EnableEvents = True
End Sub
After installing the code, save the file as an macro-enabled ("xlsm") workbook.
It can be achieved with combination of Worksheet_Change and Vlookup. Kindly put this code in sheet code section.
Once the value is entered in A1 the macro is triggered and if the values is found in the table it gets the corresponding values (description) using Vlookup. Also it enters the current date & time.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Application.EnableEvents = False
If Not Intersect(Target, Range("A1")) Is Nothing Then
Dim lastRow As Long, tblRng As Range
lastRow = Range("A" & Rows.Count).End(xlUp).Row
If lastRow <= 3 Then lastRow = 3
Set tblRng = Range("A3:D" & lastRow)
dt = Application.VLookup(Target, tblRng, 1, 0)
If Not IsError(dt) Then
With Target
.Offset(0, 1).Value = Application.VLookup(Target, tblRng, 2, 0)
.Offset(0, 2).Value = Date
.Offset(0, 2).NumberFormat = "mm/dd/yyyy"
' if you want date from tbl use Application.VLookup(Target, tblRng, 3, 0)
.Offset(0, 3).Value = TimeValue(Now())
.Offset(0, 3).NumberFormat = "hh:mm am/pm"
' if you want date from tbl use Application.VLookup(Target, tblRng, 4, 0)
End With
Else
With Target
.Offset(0, 1).Value = vbNullString
.Offset(0, 2).Value = vbNullString
.Offset(0, 3).Value = vbNullString
End With
End If
End If
Application.EnableEvents = True
End Sub