I use a macro to print the timestamp in column AJ when anything in the range A:AH is changed, but it disables the undo function in Excel. I am also using another worksheet_change event that auto capitalizes text, but it doesn't disable the undo functionality. Why does this code disable undo and is there any way around it? Thanks for any help
Private Sub Worksheet_Change(ByVal Target As Range)
' Code to print timestamp in Column AJ following a change in a corresponding row
Dim WorkRng As Range, row As Long
Dim rng As Range
Set WorkRng = Intersect(Range("A:AH"), Target)
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each rng In WorkRng
row = rng.row
If Not rng.Value = "" Then
Cells(row, "AJ").Value = Now
Cells(row, "AJ").NumberFormat = "mm/dd/yyyy hh:mm:ss"
Else
Cells(row, "AJ").Value = Now
Cells(row, "AJ").NumberFormat = "mm/dd/yyyy hh:mm:ss"
End If
Next
Application.EnableEvents = True
End If
End Sub
Related
I've got a sheet with Data.
I want to calculate the difference between date now and the date which are in cells C3:C10. And the results are stored in cells D3:D10.
That part I got it so far.
But if someone manipulates the values in the result cells then the VBA should recalculate those cells and correct the results.
Private Sub Worksheet_Change(ByVal Target As Range)
For Zeile = 3 To 10
Sheets("Tabelle2").Cells(Zeile, "D") = WorksheetFunction.YearFrac(Sheets("Tabelle2").Cells(Zeile, "C"), Date)
If Sheets("Tabelle2").Cells(Zeile, "C") = 0 Then
Sheets("Tabelle2").Cells(Zeile, "D") = ""
End If
Next Zeile
End Sub
The first thing to do is check if the change has been made in C3:C10, you can use Intersect for that.
Then you should disable events to stop the code triggering itself, use Application.EnableEvents = False for that.
Next loop through Target in case more than one cell has been changed and perform the required actions/calculations.
Finally re-enable events using Application.EnableEvents = True
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim cell As Range
Dim Zeile As Long
Set rng = Intersect(Target, Range("C3:C10"))
If Not rng Is Nothing Then
Application.EnableEvents = False
For Each cell In rng.Cells
Zeile = cell.Row
If Cells(Zeile, "C") <> 0 Then
Cells(Zeile, "D") = Application.YearFrac(Cells(Zeile, "C").Value, Date)
Else
Cells(Zeile, "D") = ""
End If
Next cell
Application.EnableEvents = True
End If
End Sub
If you want the code to be triggered if a value is changed in either C3:C10 or D3:D10 change this,
Set rng = Intersect(Target, Range("C3:C10"))
to this.
Set rng = Intersect(Target, Range("C3:D10"))
You can also change the range address there if you want to further rows by changing 10.
I would like to apply vba formula to designated cells. The vba I am working on would be: If I type something on C2, a date stamp will be automatically put in D2.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 3 Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
With Target.Offset(0, 1)
.Value = Now
.NumberFormat = "MM/DD/YYYY"
End With
End Sub
However, if I typed something on C1, a date stamp will appear as well. How can I limit the range of the vba? For example, I just want the date stamp from D2 to D5.
Thanks!!
You can apply Intersect function to check if target falls into the desired range, like this
Dim dr As Range
Set dr = Range("C2:C5")
If Not Intersect(target, dr) Is Nothing Then
... it is OK, go ahead
EndIf
The first answer is right, however here is the full version of it
Paste this in the Project of the table, not as a VBA module
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("C2:C5"), Target)
xOffsetColumn = 1
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each rng In WorkRng
If Not VBA.IsEmpty(rng.Value) Then
rng.Offset(0, xOffsetColumn).Value = Now
rng.Offset(0, xOffsetColumn).NumberFormat = "mm-dd-yyyy"
Else
rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
I'm currently setting up a small inventory tool and since I'm new to vba I got stuck.
So I got a table where you can register all the ingoing and outgoing goods and so far I've included a macro which automatically puts the date into the row if the cells in the ingoing and outgoing columns are changed.
What I want to do now is that if I delete a value in the outgoing/ingoing columns the date will disappear too.
That's my code so far:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
On Error GoTo Ende
Application.EnableEvents = False
For Each rng In Application.Intersect(Columns("D"), Target).Cells
If rng.Offset(0, -2).Value = "" Then
rng.Offset(0, -2).Value = Date
End If
Next rng
Ende:
Application.EnableEvents = True
End Sub
Anyone got an idea?
Quck and dirty fix - add another for loop that checks if the target cell is empty:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
On Error GoTo Ende
Application.EnableEvents = False
For Each rng In Application.Intersect(Columns("D"), Target).Cells
If rng.Offset(0, -2).Value = "" Then
rng.Offset(0, -2).Value = Date
End If
Next rng
For Each rng In Application.Intersect(Columns("D"), Target).Cells
If rng = "" Then
rng.Offset(0, -2).Value = ""
End If
Next rng
Ende:
Application.EnableEvents = True
End Sub
I have Sheet1 looking like this
running this code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("B2:K10"), Target)
xOffsetColumn = 11
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each rng In WorkRng
If Not VBA.IsEmpty(rng.Value) Then
rng.Offset(0, xOffsetColumn).Value = Now
rng.Offset(0, xOffsetColumn).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
Else
rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
What it does so far:
when I edit anything in range B2:K10 it adds the date & time on the right side of the table
What I need:
when I edit anything in the range specified above, log the date & time plus the corresponding step & item, all into Sheet2 starting from A2
Expected result:
And keep adding below last row over and over, never erase a record if a value is deleted from a cell in Sheet1. Will delete records manually if needed.
try this
Private Sub Worksheet_Change(ByVal Target As Range)
Dim WorkRng As Range
Dim rng As Range
Dim nextRow As Long
Set WorkRng = Intersect(Application.ActiveSheet.Range("B2:K10"), Target)
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each rng In WorkRng
If Not VBA.IsEmpty(rng.Value) Then
nextRow = Log.Cells(Rows.Count, 1).End(xlUp).Row + 1
Log.Cells(nextRow, 1) = Me.Cells(rng.Row, 1)
Log.Cells(nextRow, 2) = Me.Cells(1, rng.Column)
Log.Cells(nextRow, 3) = Now
Log.Cells(nextRow, 3).NumberFormat = "dd-mm-yyyy, hh:mm:ss"
End If
Next
Application.EnableEvents = True
End If
End Sub
The code identifies the row number of the next empty row in Sheet 2, then writes the values into the first three cells of that row.
Edit: After seeing your edits to the code: You don't need to go through the hassle of declaring a worksheet variable and then setting it to the sheet. Instead, use the (Name) property to give the sheet a name, then you can access it from anywhere in the code via this name. I adjusted the code to reflect this.
I have a code where the date is updated in the cell in column D if any change was made in the cell in the same row in column F:
Private Sub Worksheet_Change(ByVal Target As Range)
' Code to put the date of the latest update following a change in the corresponding cell in column F
Dim WorkRng As Range
Dim rng As Range
Dim xOffsetColumn As Integer
Set WorkRng = Intersect(Application.ActiveSheet.Range("F:F"), Target)
xOffsetColumn = -2 'The date is put 2 columns to the left of column F
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each rng In WorkRng
If Not VBA.IsEmpty(rng.Value) Then
rng.Offset(0, xOffsetColumn).Value = Now
rng.Offset(0, xOffsetColumn).NumberFormat = "dd/mm/yyyy"
Else
rng.Offset(0, xOffsetColumn).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
Now I need to adapt this code so that the date is updated in the cell in column D if any change was made in the cells in the same row in columns F to K.
I have very little VBA knowledge and would be grateful for any help in adapting the code.
This appears to work:
Private Sub Worksheet_Change(ByVal Target As Range)
' Code to put the date of the latest update following a change in the corresponding cell in column F
Dim WorkRng As Range, roww As Long
Dim rng As Range
Set WorkRng = Intersect(Range("F:K"), Target)
If Not WorkRng Is Nothing Then
Application.EnableEvents = False
For Each rng In WorkRng
roww = rng.Row
If Not rng.Value = "" Then
Cells(roww, "D").Value = Now
Cells(roww, "D").NumberFormat = "dd/mm/yyyy"
Else
Cells(roww, "D").ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
We just do not use OFFSET()