Same VBA code in the same worksheet for 2 different sets of table the first works, the second doesnt - excel

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

Related

Auto-Updated Validated Cell When Source Value Changes

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

How can I add a 2nd macro in excel in a existing worksheet?

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

How can I show a timestamp in excel

I am trying to add a timestamp when a change is made and I got the below Macro from a Youtube channel and I am getting an error. I am not sure if because I am using Excel- Office 365 and the video was made in 2018 but maybe you can help. Below is the code I am using and I get a "Type mismatch (Error 13)" for ("B2:AZ1000"). Do you know how to fix this?
Also, I wanted the updated time stamp to go into two columns and I am not sure if this is correct:
= Range("A,AB" & Target.Row)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myTableRange As Range
Dim myDateTimeRange As Range
Dim myUpdatedRange As Range
'Your data table Range
Set myTableRange = ("B2:AZ1000")
If Intersect(Target, myTableRange) Is Nothing Then Exit Sub
'Column for the Original Date entry
Set myDateTimeRange = Range("AC" & Target.Row)
'Column for the date/time for the Last Update
Set myUpdatedRange = Range("A,AB" & Target.Row)
If myDateTimeRange.Value = "" Then
myDateTimeRange.Value = Now
End If
myTableRange.Value = Now
End Sub
You need to be careful not to re-trigger your handler when you add the timestamps, and you need to account for the possibility that multiple rows might be updated.
Here's one way you can do it:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rw As Range, rng As Range
Set rng = Application.Intersect(Target, Me.Range("B2:AZ1000"))
If Not rng Is Nothing Then
On Error GoTo haveError
Application.EnableEvents = False '<< don't re-trigger this event handler
For Each rw In rng.Rows '<< loop each affected row
With rw.EntireRow
'Range references below are scoped to the row,
' and so are *relative* to that row...
If .Range("AC1").Value = "" Then .Range("AC1").Value = Now
.Range("A1,AB1").Value = Now
End With
Next rw
Application.EnableEvents = True
End If
Exit Sub
haveError:
Application.EnableEvents = True '<< make sure this is re-enabled
End Sub

How do i get the Timestamp to update, when the cell contains a formula referencing another cell in another worksheet?

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

VBA Timestamp executing first instance but not second

I have a large data set with a number of different columns to update. I am trying to create a way to timestamp a date/time as to when the last time a column was updated. I need to do this for 4 separate instances.
The issue i am having is that it seems to work fine for the first instance of the VBA but then wont execute on another column regardless. Please see my full code sample below:
Sub Worksheet_Change(ByVal Target As Range)
Dim myTableRange1 As Range
Dim myDateTimeRange1 As Range
Dim myUpdatedrange1 As Range
Set myTableRange1 = Range("S:S")
If Intersect(Target, myTableRange1) Is Nothing Then Exit Sub
Set myDateTimeRange1 = Range("A" & Target.Row)
Set myUpdatedrange1 = Range("X" & Target.Row)
If myDateTimeRange1.Value = "" Then
myDateTimeRange1.Value = Now
End If
myUpdatedrange1.Value = Now
End Sub
Sub Worksheet_Change2(ByVal Target As Range)
Dim myTableRange2 As Range
Dim myDateTimeRange2 As Range
Dim myUpdatedrange2 As Range
Set myTableRange2 = Range("T:T")
If Intersect(Target, myTableRange2) Is Nothing Then Exit Sub
Set myDateTimeRange2 = Range("zz" & Target.Row)
Set myUpdatedrange2 = Range("Y" & Target.Row)
If myDateTimeRange2.Value = "" Then
myDateTimeRange2.Value = Now
End If
myUpdatedrange2.Value = Now
End Sub
****UPDATE****
I have also tried to merge this code together like below:
Sub Worksheet_Change(ByVal Target As Range)
Dim myTableRange1 As Range
Dim myDateTimeRange1 As Range
Dim myUpdatedrange1 As Range
Dim myTableRange2 As Range
Dim myDateTimeRange2 As Range
Dim myUpdatedrange2 As Range
Set myTableRange1 = Range("S:S")
Set myTableRange2 = Range("T:T")
If Intersect(Target, myTableRange1) Is Nothing Then Exit Sub
If Intersect(Target, myTableRange2) Is Nothing Then Exit Sub
Set myDateTimeRange1 = Range("A" & Target.Row)
Set myUpdatedrange1 = Range("X" & Target.Row)
Set myDateTimeRange2 = Range("zz" & Target.Row)
Set myUpdatedrange2 = Range("Y" & Target.Row)
If myDateTimeRange1.Value = "" Then
myDateTimeRange1.Value = Now
If myDateTimeRange2.Value = "" Then
myDateTimeRange2.Value = Now
End If
myUpdatedrange1.Value = Now
End If
myUpdatedrange2.Value = Now
End Sub
And this resulted in neither working.
I am new to VBA so Any help would be appreciated. Thank you
You need something like this (in outline form) so as not to discount changes to a single column.
If you changed T only, your updated code would exit before getting to the relevant bit of code.
If you changed S and T, it would only do the S bit.
Sub Worksheet_Change(ByVal Target As Range)
Dim myTableRange1 As Range
Dim myDateTimeRange1 As Range
Dim myUpdatedrange1 As Range
Dim myTableRange2 As Range
Dim myDateTimeRange2 As Range
Dim myUpdatedrange2 As Range
Set myTableRange1 = Range("S:S")
Set myTableRange2 = Range("T:T")
If Not Intersect(Target, myTableRange1) Is Nothing Then
'your column S code
ElseIf Not Intersect(Target, myTableRange2) Is Nothing Then
'your column T code
End If
End Sub

Resources