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)
Related
I would like to hide rows in column B9-B40 when Index/Match formula returns "N/A" , now I managed to get it done in VBA when the table is static but I have a dynamic table based on drop-down selection which means the number of N/As returned can be different for each time drop-down selection changes.
Here is what I have right now which hides the rows with N/A based on current drop-down selection, my dropdowns are in C2,C3 and C4. But it doesn't takes any further change in the dropdown into consideration afterwards. I am not very competent with the VBA so any help would be great.
Thanks.
Option Explicit
Sub hide_if_error()
Dim MyCell As Range, Rng As Range
Set Rng = Range("B9:B40")
For Each MyCell In Rng
If IsError(MyCell) Then
MyCell.EntireRow.Hidden = True
End If
Next MyCell
End Sub
You can do
Range("B9:B40").SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Hidden = True
You will need a test in advance that errors are present though.
That might look like:
Option Explicit
Public Sub hide_if_error()
With ThisWorkbook.Worksheets("Sheet4")
.Range("B9:B40").EntireRow.Hidden = False
If Evaluate("=SUM(IF(ISERROR(" & .Range("B9:B40").Address & "),1))") > 0 Then '<==check if any errors present
.Range("B9:B40").SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Hidden = True
End If
End With
End Sub
If necessary, you could link the above to a worksheet change or dropdown change event so it is fired each time there is an update using the dropdown(s)
For example:
If you data validation was in C2:C4 you would put in the code pane for the sheet the following event code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrHand
If Not Intersect(Target, Range("C2:C4")) Is Nothing Then
Application.EnableEvents = False
hide_if_error
End If
ErrHand:
Application.EnableEvents = True
End Sub
Note:
The worksheet event code goes in the code pane associate with sheet 4:
The other code goes in a standard module (module 1 here):
Example run:
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
I have a spreadsheet that is going to be used in a survey.
How can I make the cells only to return "x" regardless of what the survey taker type in.
For instance, if I write a "w" in the cell, it should turn into an "x".
I have come to a point where I think there is an option when I protect the workbook or sheet. Because I can tell from another spreadsheet (which has this function) that it only works if the workbook is protected.
I tried to google it, but it seems as if I don't know the right keywords to find the answer.
Also, I have found a set of Vba code that I fiddle with, but I'm not sure this is correct. I don't want to attach the code as I don't want to confuse any response here.
Thank you for any help provided.
Put this code in the worksheet module and test it out, when you change a cell in column A (1) it will activate,
Where is the worksheet Module?
Copy and paste the code ,
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("A1,B1,C1,A4,B4,C4")) Is Nothing Then Exit Sub
Application.EnableEvents = 0
If Target <> "" Then Target = "X"
Application.EnableEvents = 1
End Sub
This should work for you (just change the range to the one you need) :
Option Explicit
Sub worksheet_Change(ByVal Target As Range)
On Error GoTo errorbutler 'error handler - important to have this in case your macro does a booboo
Application.Calculation = xlCalculationManual 'turn off automatic calculation to speed up the macro
Application.EnableEvents = False 'turn off events in order to prevent an endless loop
Dim LR, cell As Range 'Declare your variables
Set LR = Range("A1:b3") ' Select range of cells this macro would apply to
For Each cell In Target 'Loops through the cells that user have changed
If Union(cell, LR).Address = LR.Address Then 'Checks if the changed cell is part of your range
cell.Value="x" 'changes the value of that cell to x
End if
Next cell
Errorexit: 'part of error handling procedure
Application.EnableEvents = True 'Turn autocalc back on
Application.Calculation = xlCalculationAutomatic 'turn events back on
Exit Sub
Errorbutler: 'error handling procedure
Debug.Print Err.Number & vbNewLine & Err.Description
Resume Errorexit
End Sub
Oh yes, and this code should be put into the worksheet module - the same way as Dave has shown you
I'm working on an excel sheet wherein each row needs to indicate the last time that any cell within that row has changed. The simplest method I've found to do this is to put some tiny amount of VBA in the worksheet code, like so:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If (Target.Row > 2) And (Cells(Target.Row, "A") <> "") Then
Cells(Target.Row, "N").Value = Date
End If
Application.EnableEvents = True
End Sub
This will effectively change the date in the "N" column whenever any other item in that row is edited. Great! Solved, except...
Because I'm changing the cell value in the code, the undo stack is immediately lost, and of course this means that ANY work in this worksheet cannot be undone.
So, an alternative to this is to trick excel into thinking I haven't edited a cell. This code preserves the undo stack while changing the date:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cursorLocation As Range
Application.EnableEvents = False
If Target.Row > 2 And Cells(Target.Row, "A") <> "" Then
Set cursorLocation = ActiveCell
Cells(Target.Row, "N").Select
SendKeys "^;~", True
cursorLocation.Select
End If
Application.EnableEvents = True
End Sub
In this case, we select the cell, use SendKeys to fake editing the cell, and the restore the cursor to its original location. "^;~" is using Excel's "Ctrl+;" shortcut to input the date. Great! Solved, except...
This code works fine on my machine (Win7, Excel 2010) but fails on a co-worker's machine (Win8, Excel 2010, maybe a bit faster). On the Win8 machine (no idea if it's the OS that's the problem, btw), what happens is that whenever a cell is changed, every cell immediately below that cell becomes the current date, and of course preserving the Undo history is meaningless because executing an Undo immediately reactivates the worksheet code and turns everything into dates again.
I figured out on my own that the same thing will happen on my machine if I remove the "Wait" inherent in the SendKeys command. That is, if I use the line:
SendKeys "^;~", False
So, what I'm guessing is that for whatever reason, even when using the same version of Excel, my computer is waiting for the SendKeys command to finish, but my co-worker's computer is not. Any ideas?
You are right. It gives that problem in Excel 2010/Win8.
Try this. Use the custom Wait code that I wrote. (Tested in Excel 2010/Win8)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cursorLocation As Range
Application.EnableEvents = False
If Target.Row > 2 And Cells(Target.Row, "A") <> "" Then
Set cursorLocation = ActiveCell
Cells(Target.Row, "N").Select
SendKeys "^;~"
Wait 1 '<~~ Wait for 1 Second
cursorLocation.Select
End If
Application.EnableEvents = True
End Sub
Private Sub Wait(ByVal nSec As Long)
nSec = nSec + Timer
While nSec > Timer
DoEvents
Wend
End Sub
Alternative
Using Doevents also has the desired effect.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cursorLocation As Range
Application.EnableEvents = False
If Target.Row > 2 And Cells(Target.Row, "A") <> "" Then
Set cursorLocation = ActiveCell
Cells(Target.Row, "N").Select
SendKeys "^;~"
DoEvents
cursorLocation.Select
End If
Application.EnableEvents = True
End Sub
I'm trying to create a macro that puts the date in a cell on another worksheet, when the initial worksheet is changed, but it gives me an out of range error. Is there any way to get around this, or am I simply unable to use the Worksheet_Change for this case. If so, what can I use? I was simply trying to test it, so I only have this so far:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Worksheets("Sheet4").Activate
Range("E1").End(xlDown).Offset(1, 0).Value = Date
Application.EnableEvents = True
End Sub
I now have this:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Worksheets("Testing Sheet").Range("E2").Value = "" Then
Worksheets("Testing Sheet").Range("E2").Value = Date
Else
' Worksheets("Testing Sheet").Range("E2").End(xlDown).Offset(1, 0).Value = Date
End If
Application.EnableEvents = True
End Sub
But the statement at the Else is giving me an error saying Application defined or object defined error. (side note I don't have it commented out in my actual code)
You will get error because you are checking condition this
If Worksheets("Testing Sheet").Range("E2").Value = "" Then
For Suppose you have some value E2 Cell. So it goes to Else statement
Worksheets("Testing Sheet").Range("E2").End(xlDown).Offset(1, 0).Value = Date
But probably don't have data below E2 Cell. So .End(xlDown) Selects E1048576 Cell Which is the last allowed row supported by excel.
.Offset(1, 0).Value tries to point E1048577 Cell which is not supported.
So you get Application Defined Error. Hope this makes sense.