This code is very straightforward if any cell in the range is changed it should put date and time in the col A of that row.
This takes too long for larger range I tried to exit sub after the IF statement but it gets slow and EXCEL stops responding until it has finished with the code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range
Dim m As Long
For Each Cel In Range("B2:Z104857")
If Not Intersect(Target, Cel) Is Nothing Then
m = Cel.Row
With ActiveSheet.Range("A" & m)
.Value = Date & " " & Time
.NumberFormat = "dd/mm/yyyy hh:mm AM/PM "
End With
Exit Sub
End If
Next Cel
End Sub
My guess is that Target is smaller than Range("B2:Z104857") (which is a huge range)
So if you replace the line:
For Each Cel In Range("B2:Z104857")
by
For Each Cel In Target
you should get a dramatic speedup.
Also -- it can't hurt to put
Application.ScreenUpdating = False
at the beginning of your sub and
Application.ScreenUpdating = True
at the end.
On Edit: #CharlesWilliams points out that it is also a good idea to add the line Application.EnableEvents=False at the start of the sub and Appication.EnableEvents=True at the end. This is because event handlers can sometimes lead to cascading behavior whereby event handlers make changes which trigger other event handlers (which maybe trigger still other event handlers ...).
Can you just check target.column within your constraints, the same with rows, then cells(target.Row,1).value=now?
If (target.column>=2 and target.column<=26) and (target.row>=2 and target.row<=10000) then cells(target.Row,1).value =now
Related
This script ends up being a runtime error when more than one cell in the target is modified.
I basically need to be able to make multiple changes at once and still have the date stamp work.
I'm still new to these sorts of scripts, any help will be appreciated.
Thanks.
Private Sub Worksheet_Change(ByVal Target As Range)
' Auto Date
Dim cell As Range
'Unprotecting Text Submission tool tab
wstextsubmissiontool.Unprotect "Abc123"
For Each cell In Target
If cell.Column = Range("E:E").Column Then
If cell.Value <> "" Then
Cells(cell.Row, "C").Value = Now
Else
Cells(cell.Row, "C").Value = ""
End If
End If
Next cell
'protecting Text Submission tool tab
wstextsubmissiontool.Protect "Abc123"
End Sub
The issue is that, by changing the cell that contains the time, you are changing the worksheet, so Excel wants to run your code to change the cell that contains the time... so basically the error is to prevent an infinite loop.
The way around it is to disable events at the start of your Worksheet_Change procedure with Application.EnableEvents = False. Just be sure to re-enable events at the End of the procedure (or also if you Exit the procedure early for some reason).
A simplified example (excluding your password protection) is:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Sheets("sheet1").Range("a1") = Now()
Application.EnableEvents = True
End Sub
More Info:
Microsoft : Application.EnableEvents property
Microsoft : Worksheet.Change event
Wikipedia : Infinite Loop
"Infinite Loop" 😜 (source)
I'm have an Excel sheet with a table that performs Index/Match formula in VBA and copy the values into the table. The code is as below:
Private Sub worksheet_change(ByVal target As Range)
If Not Intersect(target, Me.ListObjects("ProjectEntry").ListColumns("Asset No").DataBodyRange) Is Nothing Then
With Me.Range("ProjectEntry[Description]")
.Formula = "=IF(ISNA(INDEX(DieMaster,MATCH(B4,DieMaster[Asset No],FALSE),2)),"""",INDEX(DieMaster,MATCH(B4,DieMaster[Asset No],FALSE),2))"
.Value = .Value
End With
End If
End Sub
I found that this code although works, will execute on all cells in the table. Now I want it to only execute in my selected row. Example, if I perform a change in A5, I want the code to execute in row 5 only.
I have tried using Offset as it worked for me in Excel when data is not in a table. Using the code below:
Private Sub worksheet_change(ByVal target As Range)
If Not Intersect(target, Me.ListObjects("ProjectEntry").ListColumns("Asset No").DataBodyRange) Is Nothing Then
With target.Offset(0, 1)
.FormulaR1C1 = "=IF(ISNA(INDEX(DieMaster,MATCH(rc1,DieMaster[Asset No],FALSE),2)),"""",INDEX(DieMaster,MATCH(rc1,DieMaster[Asset No],FALSE),2))"
.Value = .Value
End With
End If
End Sub
However it doesn't seem to work. Does this mean that Offset does not work in table? If not, is there another way?
Whilst using RC2 fixes your problem, you are far better off using RC[-1]. If you move the table or insert a column to to the left of it, the code will break using absolute references, but not using relative ones.
You are also better off using the IFERROR() function rather than IF(ISNA()) as it results in a formula that avoids repetition, and is half the length:
With Target.Offset(0, 1)
.FormulaR1C1 = "=IFERROR(INDEX(DieMaster,MATCH(RC[-1],DieMaster[Asset No],0),2),"""")"
.Value = .Value
End With
However, the best way to refresh the edited row only, is to do the calculations in VBA and write the results to the sheet.
The following code does this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("ProjectEntry[Asset No]")) Is Nothing Then Exit Sub
Dim Ä As Excel.Application: Set Ä = Excel.Application
Dim varValue As Variant
With Ä.Range("DieMaster").ListObject.ListColumns
varValue = Ä.Index(.Item(2).DataBodyRange, Ä.Match(Target.Value2, Ä.Range("DieMaster[Asset No]"), 0))
End With
Target.Offset(0, 1).Value = IIf(IsError(varValue), vbNullString, varValue)
End Sub
Note the usage of Application. instead of WorksheetFunction. to access the worksheet functions. This, coupled with the use of a Variant type variable, allows us to trap the error that occurs when the match fails.
I need some help with this code as it doesn't work properly.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Target
With Cell
If .Column = Range("W:W").Column Then
Cells(.Row, "AC").Value = Int(Now)
End If
End With
Next Cell
End Sub
I am trying to get automatic static date stamps in column "AC" every time I fill in cells in column "W" and I want to start with row "19".
Tried to use
If .Column = Range("W19").End(xldown) Then
but it doesn't work.
I've just started using macro and vba and it will really help me if you can explain any solutions to me.
Thank you
Always turn off events if you are going to write to the worksheet in order that the Worksheet_Change event macro does not try to run on top of itself.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("W:W")) Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim rng As Range
For Each rng In Intersect(Target, Columns("W:W"))
If rng.Row > 18 Then _
rng.Offset(0, 6) = Date 'or Now for datetime
Next rng
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
This should handle multiple changes to column W like a block range paste.
I have a spreadsheet where users paste numbers, due to the length of these numbers (and the fact that we don't need to spreadsheet to carry out any computations with them) we want them to be formatted as text, otherwise they appear in scientific format i.e. 1.12345E+13 instead of 12345678912345
It is not possible to adjust/modify the data source the numbers are being copied from.
I'm using Private Sub Workbook_SheetChange do detect if a cell in the relevant range has been changed, and I then format the range to text with
ThisWorkbook.Sheets("Sheet1").Columns("B").NumberFormat = "#"
Unfortunately on Excel 2007 whether you do this manually in Excel or via a marco, the number still appears as 1.12345E+13 unless you click into the cell and press enter.
I can get round this by applying:
With rng
.Value = Evaluate("IF(ISTEXT(" & .Address & "),TRIM(" & .Address & "),REPT(" & .Address & ",1))")
End With
but when I do this I end up with an infinite loop, as the Private Sub Workbook_SheetChange detects the cell has been changed and goes round the loop again.
If I could somehow work out whether the cell has been changed manually by the user or by the macro, this would be easily fixed. The macro is in ThisWorkbook. I've tried using Application.Activesheet instead of ThisWorkbook.Sheets but it didn't make any difference.
If alternatively there's an easier/better way to fix numbers being displayed as 1.12345E+13 even after I've re-formatted the cell I'd love to know about it.
Thank you.
but when I do this I end up with an infinite loop, as the Private Sub Workbook_SheetChange detects the cell has been changed and goes round the loop again.
That's because you need to disable application events from automatically firing.
Private Sub Workbook_SheetChange(ByVal Sh As Worksheet, ByVal Target As Range)
Application.EnableEvents = False '// Stop events automatically firing
With rng
.Value = Evaluate("IF(ISTEXT(" & .Address & "),TRIM(" & .Address & "),REPT(" & .Address & ",1))")
End With
Application.EnableEvents = True '// Re-enable events for next time
End Sub
Because you've disabled the events, it can't trigger itself again when you change the value of the cell. Once the code has completed you can re-enable the events to ensure that it fires the next time it is required.
For what it's worth, don't beat yourself up about it - this is an extremely common pitfall when people start working with event procedures in excel-vba.
Here's a full example, including handling Target ranges of >1 cell:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim c As Range
Application.EnableEvents = False
On Error GoTo haveError
For Each c In Application.Intersect(Target, Sh.UsedRange).Cells
With c
If IsNumeric(.Value) Then
.NumberFormat = "#"
.Value = CStr(.Value)
End If
End With
Next c
haveError:
'Make sure to re-enable events!
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Range = Range("A1") Then
If Range("A1").Value <> Range("A2").Value Then
Range("C1").Value = Range("C1").Value + 1
Range("A2").Value = Range("A1").Value
End If
End If
End Sub
that's the code however when i copy paste a set off cell, let's say 2 columns and 3 rows
it produce runtime error 13 type mismatch on line
If Target.Range = Range("A1") Then
why?
i simply wants the vba to do something everytime cell A1 changes
the value of A1 itself is an excel sum formula
You get type-missmatch error, becase you're trying to compare range (containing many cells) with single cell. If you want to do something every time cell A1 changed, use this one instead:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo ErrHandler
If Not Intersect(Target, Range("A1")) Is Nothing Then
If Range("A1").Value <> Range("A2").Value Then
Range("C1").Value = Range("C1").Value + 1
Range("A2").Value = Range("A1").Value
End If
End If
ExitHere:
Application.EnableEvents = True
Exit Sub
ErrHandler:
Resume ExitHere
End Sub
also note that I'm using Application.EnableEvents = False - it's a good habbit for Worksheet_Change event to use it. It prevents code from infinity firing itself each time you change any cell in event handler code.
UPD:
Btw, the value of A1 itself is an excel sum formula - you can't track changes of formula using above approach. I covered in details how you can do it in this question: Using Worksheet_Calculate event for tracking changes of formula
Simoco's answer should work for you. Another way (the one I usually use, though only out of habit) is to compare the addresses:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("A1").Address Then
If Range("A1").Value <> Range("A2").Value Then
Range("C1").Value = Range("C1").Value + 1
Range("A2").Value = Range("A1").Value
End If
End If
End Sub
You are getting an error because Target.Range is not defined. You should either just refer to Target (a Range Object) or Target.Address (the address of the Range Object). Secondly, depending on the context, Range("A1") refers to either the cell A1 itself (a Range Object) or the value in cell A1 (a literal value). You need to carefully think what you want to compare to what.
If, as you said, you want the comparison done whenever the value in Range("A1") changes then you should follow Simoco's suggestion.