I need to add or update timestamp, to excel workbook, if row has been changed. I am doing data import, but I need to see which row was updated/added and on which date.
So far I have found and adjusted the following code:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("A2:BL9999"), .Cells) Is Nothing Then
Application.EnableEvents = False
With .Cells(1, 65)
.NumberFormat = "yyyy.mm.dd"
.Value = Now
End With
Application.EnableEvents = True
End If
End With
End Sub
The problem is, timestamp is always added relative to the row where the changes have been made + 65 rows, not in column BM (index 65).
Can you advise me, which function should I use or change?
As well as the fix for column BM better to
process all the rows that may have changed rather than exit withput any record
turn-off ScreenUpdating for speed
code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Intersect(Target, Range("A2:BL9999"))
If rng1 Is Nothing Then Exit Sub
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
For Each rng2 In rng1.Cells
With Cells(rng2.Row, 65)
.NumberFormat = "yyyy.mm.dd"
.Value = Now
End With
Next
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
To change your reference relative to the entire row, use .EntireRow.
So that line should read: With .EntireRow.Cells(1, 65)
Note that you can still use A1 style references even when working with a single row. This can keep you from having to count columns. For instance, and in this case, .EntireRow.Range("BM1") means the exact same thing as .EntireRow.Cells(1, 65).
Related
I'm trying to record the value that changes every one minute from cell "B2" into cell "D2". When the values are recorded to "D2" in a row, I want to add the date and time at the same time it recorded into cell "E". Here, below is my code.
Private Sub Worksheet_Calculate()
Application.EnableEvents = False
Me.Range("D" & Me.Rows.Count).End(xlUp).Offset(1).Value = Me.Range("B2").Value
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim targetRng As Range
Dim rng As Range
Dim c As Integer
Set targetRng = Intersect(Application.ActiveSheet.Range("D:C"), Target)
c = 1
If Not targetRng Is Nothing Then
Application.EnableEvents = False
For Each rng In targetRng
If Not VBA.IsEmpty(rng.Value) Then
rng.Offset(0, c).Value = Now
rng.Offset(0, c).NumberFormat = "dd/mm/yyyy, hh:mm:ss AM/PM"
Else
rng.Offset(0, c).ClearContents
End If
Next
Application.EnableEvents = True
End If
End Sub
It seems that every time the value has recorded, the date and time in cell "E" do not appear to work together.
Any solution here?
I recommend creating a seperate Sub that is not directly hit by an event. Rewrite code below for your purposes.
Private Sub Worksheet_Calculate()
SharedSheetEvent()
end sub
Private Sub Worksheet_Change(ByVal Target As Range)
EditingSheet = true
call SharedSheetEvent()
editingsheet = false
end sub
global EditingSheet as bool
public Sub SharedSheetEvent()
if (EditingSheet) Then
do some stuff
else
do some other stuff
end if
end sub
The code below will do what you want. No two procedures are needed but if you don't specify the sheet, meaning you let it work on the ActiveSheet, it would be a bit of a lose cannon.
Private Sub Worksheet_Calculate()
Dim LastRecord As Range ' cell last written to
Dim NewValue As Variant ' current value in B2
Debug.Print "calculate"
With Worksheets("Sheet1") ' change to suit
Set LastRecord = .Cells(.Rows.Count, "D").End(xlUp)
NewValue = .Cells(2, "B").Value
With LastRecord
If .Value <> NewValue Then ' skip if no change
Application.EnableEvents = False
.Offset(1).Value = NewValue
With .Offset(1, 1)
.Value = Now()
.NumberFormat = "dd/mm/yyyy, hh:mm:ss AM/PM"
End With
Application.EnableEvents = True
End If
End With
End With
End Sub
The question is not, however, how the code works but when. I presume that B2 is changed by a program that works on a timer. The change generated by it doesn't trigger the Worksheet's Change event. You did find out, however, that it triggers the Calculate event. That is my presumption and I couldn't test it. If that is so my procedure will solve your problem.
I have programmed a similar thing recently using a timer of my own to trigger running my procedure. It's just a timer that runs at the same interval as the other and checks every minute (for example) if B2 has changed and records the change if there was one. That works. But if your updater triggers the Calculate event that looks like a neater idea.
I'm doing some data validation work and basically, whenever I alter a line in the data I also need to write "Yes" in J-column on the same line. I figured this should be automatizable, but I had some trouble with the code.
What I want it to do is to check for changes in C-H rows, and if there's a numeral (0-99) on the B-column, then replace the text on the J-column of the same line with "Yes" (without the quotation marks). The "numeral"-part can be abbreviated to having length of 1-2 (not 0 and not more) in this case.
Here's what I have thus far, but I can't seem to figure out how to do the combination of absolute and relative reference, i.e. "check B of the active row" or "alter J of the active row" (that is to say, none of the codes I've tried thus far have been valid according to VBA; I have very little VBA experience so this code feels alien to me):
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C:H")) Is Nothing Then Exit Sub
If Not Len("B" & ActiveCellRow) = "1" Then
If Not Len("B" & ActiveCellRow) = "2" Then
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
"J" & ActiveCellRow = "Yes"
.EnableEvents = True
.ScreenUpdating = True
End With
You can do something like this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, c As Range, v
'in our range of interest?
Set rng = Application.Intersect(Target, Me.Range("C:H"))
If Not rng Is Nothing Then
'get the corresponding cells in ColB
For Each c In Application.Intersect(rng.EntireRow, Me.Range("B:B")).Cells
v = c.Value
'flag required?
If Len(v) > 0 And Len(v) < 3 And IsNumeric(v) Then
c.EntireRow.Cells(1, "J").Value = "Yes"
End If
Next c
End If
End Sub
Keep getting error mentioned in the title on the "insert" line of code. Both the cut and insert lines of code appear to be the same size. I've been staring at this thing for hours. I can't figure out where I'm messing up.
Sub Worksheet_Change(ByVal Target As Range)
'convert communites by status
If Not Intersect(Target, Range("H1:H1000")) Is Nothing Then
If Cells(Target.Row, 8) = "Takedown" Then
Range(Target.EntireRow, Target.Offset(13, 0).EntireRow).Cut
Sheets("AIKEN.AUGUSTA-TAKEDOWN").Range(Range("A12").EntireRow,
Range("A25").EntireRow).Insert
Range("B12:B25").Interior.ColorIndex = 3
Range("C13").Select
End If
End If
End Sub
expected result: row range is cut from one part of the sheet and inserted in a different area of the sheet.
Actual result: error on insert line of code.
Try this:
Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Target.CountLarge > 1 Then Exit Sub
Set rng = Application.Intersect(Target, Me.Range("H26:H1000"))
If Not rng Is Nothing Then
If Cells(rng.Row, 8) = "Takedown" Then
Application.EnableEvents = False '<< don't re-trigger on Cut
Range(rng.EntireRow, rng.Offset(13, 0).EntireRow).Cut
Me.Range("A12:A25").EntireRow.Insert
Application.EnableEvents = True '<< re-enable events
Me.Range("B12:B25").Interior.ColorIndex = 3
Me.Range("C13").Select
End If
End If
End Sub
I am currently trying to add a script into excel. excuse my terminology, I am not that hot with programming!
I do all of my accounting on excel 2003, and I would like to be able to add the value of say cells f6 to f27 to the cells e6 to e27, respectively. The thing is, I want the value of the "f" column to reset every time.
So far I have found this code, which works if I copy and paste it into VBA. but it only allows me to use it on one row:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = Range("f7").Address Then
Range("e7") = Range("e7") + Range("f7")
Range("f7").ClearContents
End If
Application.EnableEvents = True
End Sub
would somebody be kind enough to explain how I can edit this to do the same through all of my desired cells? I have tried adding Range("f7",[f8],[f9] etc.. but i am really beyond my knowledge.
First, you need to define the range which is supposed to be "caught"; that is, define the range you want to track for changes. I found an example here. Then, simply add the values to the other cell:
Private Sub Worksheet_Change(ByVal Target as Range)
Dim r as Range ' The range you'll track for changes
Set r = Range("F2:F27")
' If the changed cell is not in the tracked range, then exit the procedure
' (in other words, if the intersection between target and r is empty)
If Intersect(Target, r) Is Nothing Then
Exit Sub
Else
' Now, if the changed cell is in the range, then update the required value:
Cells(Target.Row, 5).Value = Cells(Target.Row, 5).Value + Target.Value
' ----------------^
' Column 5 =
' column "E"
' Clear the changed cell
Target.ClearContents
End if
End Sub
Hope this helps
Try this
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
If Intersect(Target, Range("B1:B5,F6:F27")) Then 'U can define any other range
Target.Offset(0, -1) = Target.Offset(0, -1).Value + Target.Value ' Target.Offset(0,-1) refer to cell one column before the changed cell column.
'OR: Cells(Target.row, 5) = Cells(Target.row, 5).Value + Target.Value ' Where the 5 refer to column E
Target.ClearContents
End If
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
The code:
Private Sub Worksheet_change(ByVal target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim cell
For Each cell In Me.UsedRange.Columns("E").Cells
If cell.Text = "Cu" And cell.offset(0, -1) = "WR229" Then
MsgBox "Cu not permitted for WR229 or larger waveguide", vbOKOnly, "Cu Alert"
cell = "Al"
End If
Next cell
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
The problem is that when the condition is met the cell does not get reset to the value "Al". Why not?
One possible reason the OP's code can fail is if the UsedRange does not start in column A. This will occur if there is no data and no formatting at all in column A.
Why? Because .Columns (and .Rows and .Cells for that matter) are relative to the specified range. For example if the UsedRange is B2:Z10 then Me.UsedRange.Columns("E") will refer to range F2:F10.
Another issue in the OP's code is that it will run for any cells change, including those in Column A. This will throw an error because Offset -1 from Column A is invalid.
So, how to fix it? As answered by jbarker2160, you should take advantage of the Target parameter, which tells you which cells have changed. However that answer leaves several problems.
We want to check for Column E = "Cu" and Column D for "WR229", but we don't know which one will be entered first
We should account for the possibility that several cells are changed at once, eg due to a copy/paste
we should handle possible errors and not leave Events disabled
The OP's code is case sensitive. Ie "CU" will be accepted when "Cu" is not. Is this the desired behaviour? (If it is, remove the UCase$()'s from the code below)
Implicit in the OP's code is that there is a range of larger waveguides that are disallowed for Cu. This remains un-addressed in the code below.
This code addresses the above issues
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rw As Range
On Error GoTo EH
Application.ScreenUpdating = False
Application.EnableEvents = False
For Each rw In Application.Intersect( _
Target.EntireRow, Me.UsedRange.EntireRow.Columns("D:E")).Rows
If UCase$(rw.Cells(1, 2)) = "CU" And UCase$(rw.Cells(1, 1)) = "WR229" Then
MsgBox "Cu not permitted for WR229 or larger waveguide", _
vbOKOnly, "Cu Alert"
rw.Cells(1, 2) = "Al"
End If
Next
EH:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Code
Private Sub Worksheet_change(ByVal target As Range)
Application.ScreenUpdating = False
Application.EnableEvents = False
If target = "Cu" And target.offset(0, -1) = "WR229" Then
MsgBox "Cu not permitted for WR229 or larger waveguide", vbOKOnly, "Cu Alert"
target = "Al"
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Explanation
Since you are doing this loop for each change, you don't need to loop through the entire column and using target will get around having to use the Value property.
Change this line:
cell = "Al"
To this:
cell.Value = "Al"