I want to achieve a macro that is automatically triggered when data is copied into a table. The macro should execute ENTER + F2 in the whole table.
So far I have this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("B8")) Is Nothing Then
Range("Input_Table").Select
Selection.Value = Selection.FormulaR1C1
End If
End Sub
Cell B8 is the top left cell of my table, which is called "Input_Table".
The macro works in itself but triggering it automatically by copying a whole bunch of data into the table often crashes excel or triggers Out of Stack Error.
Is there a way to write this more efficient?
Turn off event handling or the Worksheet_Change will just try to run on top on itself when it writes values.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B8")) Is Nothing Then
on error goto safe_exit
application.enableevents = false
Range("Input_Table").FormulaR1C1= Range("Input_Table").FormulaR1C1
End If
safe_exit:
application.enableevents = true
End Sub
You do not want to write formulas into values; it is possible that you might have a formula. Use .Value2 which is the raw underlying value devoid of date or regional currency 'markers'. The cell's original formatting will restore these to the .Value.
Related
its me....again. I am currently trying to have a Macro trigger whenever a specific cell increases on a specific sheet.
After many attempts I have been able to get the Macro to trigger when the cell is changed (increasing or decreasing) but I cannot figure out a way to have this Macro trigger only when the specified cell increases in value.
I have tried to use simple Worksheet_Change with an If Then statement that calls the Macro when the cell value is changed. Again I can't get this to trigger only when the cell increases. Not sure it is possible or if I am even thinking about this is in the right way.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address "Range" Then
Call MyMacro
End If
End Sub
Thank you for any help in advance. This would be really neat and save alot of manual clicking around.
Here is the functioning Macro that I want to trigger when certain text is entered into a range.
Sub Auto_Print_Yellow_Caution()
Application.ScreenUpdating = False
Sheets("Saver").Shapes("Group 6").Copy
Sheets("Main").Select
ActiveCell.Offset(-1, 0).Select
ActiveSheet.Paste
ActiveCell.Select
Application.ScreenUpdating = True
End Sub
I already have my Workbook set up to track these words/phrases and return either a TRUE or FALSE value. If TRUE the associated Order Number is Printed into a Cell and a COUNTIFS formula is used to keep track of how many orders meet the TRUE condition. That number is then used to keep track of how many total of those orders there are. That works using the following
=IF(ISNUMBER(SEARCH("Completed",Main!G7)),TRUE)
-looks for specific word and returns TRUE
=IF(T3=TRUE,Main!A7,"")
-Returns order number
=IF(COUNTIF($U3:$U$200,"?*")<ROW(U3)-2,"",INDEX(U:U,SMALL(IF(U$2:U$200<>"",ROW(U$2:U$200)),ROWS(U$2:U3))))
-Sorts order numbers into list
=COUNTIF(T2:T135,TRUE)
-Counts number of orders
Hopefully this adds context to what I am trying to accomplish.
This will hopefully get you on the right track. As per your question it assumes this is required for a single cell only (and in this example code, that cell is B2). The trick is to store the new value, 'undo' the change, grab the old value, reverse the 'undo' by replacing the new value. Then you can test if the values are numbers and, if so, test if the new number is greater than the old number.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim newValue As Variant, oldValue As Variant
If Target Is Nothing Then Exit Sub
If Target.Cells.Count <> 1 Then Exit Sub
If Target.Column <> 2 Or Target.Row <> 2 Then Exit Sub ' example is using cell B2
Application.EnableEvents = False
newValue = Target.Value2
Application.Undo
oldValue = Target.Value2
Target.Value2 = newValue
Application.EnableEvents = True
If IsNumeric(oldValue) And IsNumeric(newValue) Then
If CDbl(newValue) > CDbl(oldValue) Then
Call MyMacro
End If
End If
End Sub
Here is some logic I can think of, you need to have a helper cell to store previous data and compare if it increased. In this sample my helper cell is B1 and the cell I want to track is A1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KCells As Range
Set KCells = Sheet10.Range("A1")' The variable KeyCells contains the cells that will
If Not Application.Intersect(KCells, Range(Target.Address)) Is Nothing Then 'cause an alert when they are changed.
If Sheet10.Range("B1").Value < Sheet10.Range("A1").Value Then
MsgBox "Replace this to call macro"
Sheet10.Range("B1").Value = Sheet10.Range("A1").Value 'this is to save the current data incase you change it later.
End If
End If
End Sub
I want to lock the cell after entering a value in it. When I change the value on sheet2 A1, the value should still be locked in B2.
When I enter "3" in Sheet2 A1 the number 2 should till be there.
Here the code I already have:
Private Sub Worksheet_Change(ByVal Target As Range)
Sheet1.Unprotect "1234"
If VBA.IsEmpty(Target.Value) Then
Target.Locked = False
Else
Target.Locked = True
End If
Sheet1.Protect "1234"
End Sub
My first answer was assuming that cell Locking referred to the Range.Locked property but now I understand that was intended to refer to the cell values and preventing them from recalculating.
There are a few techniques that can be used to prevent cells from recalculating. The easiest would be to just change any formulas into a static value like:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Target.Value = Target.Value
Application.EnableEvents = True
End Sub
This event will get rid of every formula after it calculates its value the first time. Every cell will just be whatever value the user enters or whatever value the formula calculates the first time.
You can limit the range that the event will operate within by using Intersect like:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim OperationalArea As Range, AffectedArea As Range
Set OperationalArea = Me.Range("B2:F10")
Set AffectedArea = Intersect(Target, OperationalArea)
If Not AffectedArea Is Nothing Then
Application.EnableEvents = False
AffectedArea.Value = AffectedArea.Value
Application.EnableEvents = True
End If
End Sub
This would limit the event to only change cells within the area "B2:F10" as defined in OperationalArea.
If you don't like this idea you can try messing about with Application.Calculation but it gets very messy when you have multiple sheets or workbooks open.
When you do Worksheet.Protect, every cell is locked by default. You need to specify which cells should still be editable (not locked) after protecting the sheet. In your case, you need to specify that every cell except your chosen few are not locked.
The second important note is that Worksheet.Protect has an option UserInterfaceOnly which when true, allows macros to continue editing cells without needing to unprotect the sheet first. This means you can leave the sheet protected and just unlock or lock cells as needed.
Here is an example of how to unlock every cell except A1 on Sheet1:
Sub Example()
With Sheet1
.Protect Password:="1234", UserInterfaceOnly:=True
.Cells.Locked = False
.Cells(1, 1).Locked = True
End With
End Sub
From the picture below, all of the data being displayed is populated at run time. Nothing in range E is input at run time, however, I want to write a piece of code in the module that will disable/clear contents of the cells highlighted in yellow. I would only know the row number at run time though. For example, I would know that row 4 will need to have cell E4 disabled for any offline data entry. I have a piece of code that disables the whole range but I only want selective cells to not accept text. I want all cells under E, except E4, E7, E10, E17 and E20, to be able to accept input. Thanks in advance for your help!
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("E1:E10"), Target) Is Nothing Then
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
End Sub
* Adding Additional screen grabs to help w/ the run time error *
When the control hits the breakpoint below, it gets transferred to the code written in the Sheet.
Error encountered here.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("E1:E10"), Target) Is Nothing Then
'If Target.Offset(0, -2).Value = "" Then ' 1st check - e.g. C4 is empty OR
If Target.Offset(0, -3).Value Like "*stor*" Then ' 2nd check - e.g. B4 contains "*stor*"
' let the user change this cell
Else
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
End If
End Sub
I can make one or the other of the below codes work, but need them both. The first locks cells in range upon data entry, the second inserts a date stamp when the final data entry in column D of each row is completed.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
On Error Resume Next
Set xRg = Intersect(Range("A8:D5005"), Target)
If xRg Is Nothing Then Exit Sub
Target.Worksheet.Unprotect Password:="Midnight"
xRg.Locked = True
Target.Worksheet.Protect Password:="Midnight"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range("D8:D5005")
If Not Intersect(Target, rng) Is Nothing Then
Target.Offset(0, 1) = Now
Target.Offset.NumberFormat = "dd/mm/yyyy hh:mm:ss"
End If
End Sub
I'm still guessing a bit exactly what you're trying to do … but here is way to allow your users enter four data points ... and then to press button to add the data points to a protected list … and includes a time stamp.
First setup 4 data entry cells in A4 through to D4 by using the Format Cell option, make sure for these cells that Locked is unchecked on the Protection tab.
Next create a button and link the button to the following code:
Sub ButtonCode()
ActiveSheet.Unprotect Password:="A"
Range("A7:E7").Insert xlShiftDown
Range("A4:D4").Copy Range("A7:D7")
Range("E7") = Now()
Range("A7:E7").Interior.Color = rgbLightBlue
Range("A7:E7").Font.Color = rgbBlack
ActiveSheet.Protect Password:="A"
End Sub
As a once only step, protect the worksheet; my example consistently uses a password of "A". Note that your users will not need to enter the password at any time.
Once the sheet is setup, when the button is clicked, the code unlocks the sheet (allowing it to make edits), it move the existing data data down, copy the new data points to the top of the list, adds timestamp and some minimal formatting. It then re-enables protection so that the user can't overwrite the existing entries.
The screenshot below gives you an idea of what it might look like, including showing that A4:D4 need to be unlocked.
Maybe not the implementation direction you were thinking of … but the principles included in this example might work for you. All the best.
I'm not 100% sure of the structure of your worksheet, so here are the assumptions for my response. You only want the user to modify cells in the range "A8:D5005" … and somewhere on the sheet you want to record date/timestamp changes for cells changed.
So I would start by protecting the sheet by going to the Excel "Review" ribbon (not in VBA), and setting up an editable range as follows.
Before you close the dialog box, click on Protect Sheet so that the rest of the sheet is password protected.
Once you've done this … you can use something like the code below to record the date/timestamps. In this example … I record them in columns to the right of your editable range (given your editable data is only to Column D).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vIntersect As Variant
Set vIntersect = Application.Intersect(Target, Range("A8:D5005"))
If Not vIntersect Is Nothing Then
Application.EnableEvents = False
Target.Worksheet.Unprotect Password:="Midnight"
Target.Offset(0, 5) = Now
Target.Offset(0, 5).NumberFormat = "dd/mm/yyyy hh:mm:ss"
Target.Worksheet.Protect Password:="Midnight"
Application.EnableEvents = True
End If
End Sub
I need to lock a range of cells based on another cell's value. This is obviously impossible using worksheet functions, and subs only run at click.
Can I create a formula that locks cells with VBA? I tried this but the formula returns #VALUE! error.
Function lo(range)
lo(range) = range.Select
Selection.Locked = True
End Function
Thanks.
Here's an example:
Sheet1 Code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value <> 1 Then
Target.Offset(0, 1).Locked = True
Else
Target.Offset(0, 1).Locked = False
End If
End Sub
Important: You have to set all cells locked property to False by default.
Thisworkbook code: For above to work, you have to add another event.
Private Sub Workbook_Open()
Sheet1.Protect userinterfaceonly:=True
'Thisworkbook.Sheets("Sheet1").Protect userinterfaceonly:= True
End Sub
What above does is protect Sheet1. I used its code name although it can be written also using the commented line.
Sheet1 is where you set up all cells locked property to false.
So everytime you enter something in a cell, if it is not 1, the adjacent cell will be locked for editting.
Hope this somehow help your purpose.