The following code is what gives me an initial timestamp (N) and updated time (O).
This works when the cell's in column D on WORKSHEET1 are manually updated.
The cell's in Column D WORKSHEET1 reference WORKSHEET2 Column E now. So for example D4 on WORKSHEET1 is ='WORKSHEET2'!E23.
When values are updated on WORKSHEET2, the D column on WORKSHEET1 updates automatically.
The timestamp code below then stops working and does not pick up this value change.
Can I insert a VBA code so that when i change the values on WORKSHEET2, and it updates on WORKSHEET1 because of the formula in cel D, the timestamp will work?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myTableRange As Range
Dim myDateTimeRage As Range
Dim myUpdatedRange As Range
Set myTableRange = Range("D1:D314")
If Intersect(Target, myTableRange) Is Nothing Then Exit Sub
Set myDateTimeRage = Range("N" & Target.Row)
Set myUpdatedRange = Range("O" & Target.Row)
If myDateTimeRage.Value = "" Then
myDateTimeRage.Value = Now
End If
myUpdatedRange.Value = Now
End Sub
Try this -
Private Sub Worksheet_Calculate()
Dim myTableRange As Range
Dim myDateTimeRage As Range
Dim myUpdatedRange As Range
Set myTableRange = Range("D1:D314")
For Each cell In myTableRange
Dim OldValue As Variant
Application.EnableEvents = False
Application.Undo
OldValue = cell.Value
Application.Undo
Application.EnableEvents = True
If OldValue <> cell.Value Then
Set myDateTimeRage = Range("N" & cell.Row)
Set myUpdatedRange = Range("O" & cell.Row)
If myDateTimeRage.Value = "" Then
myDateTimeRage.Value = Now
End If
myUpdatedRange.Value = Now
End If
Next cell
Related
I'm trying to update cells that have data validation restrictions on them automatically.
For example - Sheet1 has below column (Column E):
Package Identifier
A
B
C
where the values are taken from the same named column (Column D) in Sheet2.
The below code works for MANUAL changes only
Sheet2 Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim count_cells As Integer
Dim new_value As String
Dim old_value As String
Dim rng As Range
For count_cells = 1 To Range("D1").CurrentRegion.Rows.Count - 1
Set rng = Worksheets("Sheet1").Range("E3:E86")
If Intersect(Target, Range("D" & count_cells + 1)) Is Nothing Then
Else
Application.EnableEvents = False
new_value = Target.Value
Application.Undo
old_value = Target.Value
Target.Value = new_value
rng.Replace What:=old_value, Replacement:=new_value, LookAt:=xlWhole
Target.Select
End If
Next count_cells
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
So, if i manually change value B to Z, all the corresponding values that were B on Sheet1 now change to Z. The problem is, Package Identifier on Sheet2 is dictated by concatenating other columns
=CONCATENATE(B35, "-", "Package", "-", TEXT(C35, "#000"))
This piece of code breaks when trying to use it with the above formula. How can i make this set of code trigger on this formula based output?
Assuming this is how the Validation sheet looks
and this is how the Source sheet looks
Let's say user selects first option in Validation sheet.
Now go back to Source sheet and change 1 to 2 in cell C2.
Notice what happens in Validation sheet
If this is what you are trying then based on the file that you gave, test this code.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim aCell As Range
Dim NewSearchValue As String
Dim OldSearchValue As String
Dim NewArrayBC As Variant
Dim OldArrayA As Variant, NewArrayA As Variant
Dim lRow As Long, PrevRow As Long
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Range("B:C")) Is Nothing Then
lRow = Range("A" & Rows.Count).End(xlUp).Row
'~~> Store new values from Col A, B and C in an array
NewArrayBC = Range("B1:C" & lRow).Value2
NewArrayA = Range("A1:A" & lRow).Value2
Application.Undo
'~~> Get the old values from Col A
OldArrayA = Range("A1:A" & lRow).Value2
'~~> Paste the new values in Col B/C
Range("B1").Resize(UBound(NewArrayBC), 2).Value = NewArrayBC
'~~> Loop through the cells
For Each aCell In Target.Cells
'~~> Check if the prev change didn't happen in same row
If PrevRow <> aCell.Row Then
PrevRow = aCell.Row
NewSearchValue = NewArrayA(aCell.Row, 1)
OldSearchValue = OldArrayA(aCell.Row, 1)
Worksheets("Validation").Columns(2).Replace What:=OldSearchValue, _
Replacement:=NewSearchValue, Lookat:=xlWhole
End If
Next aCell
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
A different approach from Sid's...
Instead of updating values in the DV cells when the source range changes, this replaces the selected value with a link to the matching cell in the DV source range.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngV As Range, rng As Range, c As Range, rngList As Range
Dim f As Range
On Error Resume Next
'any validation on this sheet?
Set rngV = Me.Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
If rngV Is Nothing Then Exit Sub 'no DV cells...
Set rng = Application.Intersect(rngV, Target)
If rng Is Nothing Then Exit Sub 'no DV cells in Target
For Each c In rng.Cells
If c.Validation.Type = xlValidateList Then 'DV list?
Set rngList = Nothing
On Error Resume Next
'see if we can get a source range
Set rngList = Evaluate(c.Validation.Formula1)
On Error GoTo 0
If Not rngList Is Nothing Then
Application.EnableEvents = False
'find cell to link to
Set f = rngList.Find(c.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not f Is Nothing Then
Application.EnableEvents = False
c.Formula = "='" & f.Parent.Name & "'!" & f.Address(0, 0)
Application.EnableEvents = True
End If
Else
Debug.Print "No source range for " & c.Address
End If
End If
Next c
End Sub
I'm using the following VBA module to create a Timestamp UDF, which stamps the date once the referenced cell reads "Done":
Function Timestamp(Reference As Range)
If Reference.Value = "Done" Then
Timestamp = Format(Date, "ddd dd mmm")
Else
Timestamp = ""
End If
End Function
The date stays the same even after refreshing / closing and opening the workbook as long as the referenced cell still reads "Done"; however if someone accidentally changes the referenced cell then the date is reset.
I need a VBA code to convert the formula to value once it has calculated, so the date will always stay the same. The solution needs to be automatic rather than manual and I can't enable iterative formulas on this workbook because it's used by multiple users. Any help much appreciated!
You can use the Worksheet Change event for that:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedCells As Range
Set AffectedCells = Intersect(Target, Me.Range("A:A")) ' Range A:A is the range we observe for 'done'
If AffectedCells Is Nothing Then Exit Sub
Dim Cell As Range
For Each Cell In AffectedCells
If Cell.Value = "done" Then
Dim UpdateTimestamp As Boolean
UpdateTimestamp = True
If Range("B" & Cell.Row).Value <> vbNullString Then
UpdateTimestamp = MsgBox("Timestamp exists do you want to update it?", vbQuestion + vbYesNo) = vbYes
End If
If UpdateTimestamp Then
Me.Range("B" & Cell.Row).Value = Format$(Date, "ddd dd mmm")
End If
End If
Next Cell
End Sub
// Edit according comment:
If you want to check multiple ranges for different things you need to slightly change your code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
Dim ObservedRangeA As Range
Set ObservedRangeA = Intersect(Target, Me.Range("A:A")) ' Range A:A is the range we observe for 'done'
If Not ObservedRangeA Is Nothing Then
For Each Cell In ObservedRangeA
If Cell.Value = "done" And Range("B" & Cell.Row).Value = vbNullString Then
Me.Range("B" & Cell.Row).Value = Format$(Date, "ddd dd mmm")
End If
Next Cell
End If
Dim ObservedRangeB As Range
Set ObservedRangeB = Intersect(Target, Me.Range("C:C")) ' Range C:C is the range we observe for ""
If Not ObservedRangeB Is Nothing Then
For Each Cell In ObservedRangeB
If Cell.Value = "" And Range("B" & Cell.Row).Value = vbNullString Then
Me.Range("B" & Cell.Row).Value = Format$(Date, "ddd dd mmm")
End If
Next Cell
End If
End Sub
I am updating a sales tool in excel. It currently has 1 small macro that will automatically update when a user inputs or selects a new status by adding a time stamp.
I want to add another macro on the same sheet but in a different range of cells. This would update when a sale is made when the user updates to SOLD to also have a new time stamp. I tried creating a new variable and repeated the If / then statement with new range and new variables but it did not work.
The first If /Then works without issue the myTimeRange, but the 2nd If/then mySoldRange is not.
Here is the code snip
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myTableRange As Range
Dim myDateTimeRange As Range
Dim myUpdatedRange As Range
Dim mySoldRange As Range
Dim mySoldTimeRange As Range
Dim mySoldUpdatedRange As Range
Set myTableRange = Range("A2:E300")
Set mySoldRange = Range("H2:K300")
If Intersect(Target, myTableRange) Is Nothing Then Exit Sub
Set myDateTimeRange = Range("F" & Target.Row)
Set myUpdatedRange = Range("G" & Target.Row)
If myDateTimeRange.Value = "" Then
myDateTimeRange.Value = Now
End If
If Intersect(Target, mySoldRange) Is Nothing Then Exit Sub
Set mySoldTimeRange = Range("H" & Target.Row)
Set mySoldUpdatedRange = Range("K" & Target.Row)
If mySoldTimeRange.Value = "" Then
mySoldTimeRange.Value = Now
End If
myUpdatedRange.Value = Now
mySoldUpdatedTimeRange.Value = Now
End Sub
If Intersect(Target, myTableRange) Is Nothing Then Exit Sub
You can't use Exit Sub here if you want to test if Target intersects another range.
Change instead to:
If Not Intersect(Target, myTableRange) Is Nothing Then
Set myDateTimeRange = Range("F" & Target.Row)
Set myUpdatedRange = Range("G" & Target.Row)
If myDateTimeRange.Value = "" Then
myDateTimeRange.Value = Now
End If
End If
and similarly (though not technically necessary, but to be consistent):
If Not Intersect(Target, mySoldRange) Is Nothing Then
...
End If
Hi could someone help adjust this so the alert message says the value of A2 AND B2.
Private Sub Worksheet_Calculate()
Dim myRange As Range
Set myRange = ActiveSheet.Range("F2:F2")
Dim cell As Range
For Each cell In myRange
Evaluate (cell)
If StrComp(cell, "Yes", vbTextCompare) = 0 Then
MsgBox Join(Application.WorksheetFunction.Transpose(Range("A1:A10").Value), Chr$(10))
End If
Next
End Sub
I have modified my original post to comply with your better explanation.
Sub Worksheet_Calculate()
Dim myRange As Range
Dim Cell As Range
Set myRange = ActiveSheet.Range("F2:F2")
For Each Cell In myRange
Evaluate (Cell)
If StrComp(Cell, "Yes", vbTextCompare) = 0 Then
MsgBox "A2 = " & CStr((Cells(2, "A").Value) & vbCr & _
"B2 = " & CStr(Cells(2, "B").Value))
End If
Next Cell
End Sub
I found the below code to input a timestamp automatically when one specific range has anything written and I wanted to do this in 2 specific places within the same worksheet, hence I wrote the same sequence, however the 1st works and the second doesnt, below my code:
Private Sub Worksheet_Change(ByVal Target As Range)
'==============logdate timestamp completed============
Dim myTableRange As Range
Dim myDayTimeRange As Range
'my Data Table Range
Set myTableRange = Range("E:E")
If Not Intersect(Target, myTableRange) Is Nothing Then
'Column for the date
Set myDateTimeRange = Range("A" & Target.Row)
If myDateTimeRange.Value = "" Then
myDateTimeRange.Value = Now
End If
End If
'==============logdate timestamp inflight============
Dim myTableRangeif As Range
Dim myDayTimeRangeif As Range
'my Data Table Range
Set myTableRangeif = Range("N19:R19")
If Not Intersect(Target, myTableRangeif) Is Nothing Then
'Column for the date
Set myDateTimeRangeif = Range("J" & Target.Row)
If myDateTimeRangeif.Value = "" Then
myDateTimeRangeif.Value = Now
End If
End If
End Sub
Just changed the code as suggested however the timestamp appears on the "A" column but not on the "J" one
When you change something in Range("N19:R19"), the Exit Sub is executed because it is true that Intersect(Target, myTableRange) Is Nothing.
You need to change the logic of Exiting the Sub if the Intersection is nothing.
If Not Intersect(Target, myTableRange) Is Nothing Then
'Column for the date
Set myDateTimeRange = Range("A" & Target.Row)
If myDateTimeRange.Value = "" Then
myDateTimeRange.Value = Now
End If
End If
...
If Not Intersect(Target, myTableRangeif) Is Nothing Then
'Column for the date
Set myDateTimeRangeif = Range("J" & Target.Row)
If myDateTimeRangeif.Value = "" Then
myDateTimeRangeif.Value = Now
End If
End If