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
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 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 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.
I have this sub on one of my page, I want that when the user changes one of the cells in B2:B10, the date appears in the column A on the same line :
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Application.Intersect(Target, Range("B2:B10")) Is Nothing Then
Target.Offset(0, -1).Value = Date
End If
End Sub
It works well, but if I select the range A2:B10 and I press Delete I have a 1004 Run Time Error. Do you know why and how I could avoid that ?
Thanks !
When selecting a range from A2 to B10, the intersect in your if is true, but when using Target.Offset(0, -1) you are trying to address a range that is to the left of column A. Because column A is the first one, this obviously leads to an error.
So try to check if the Target.Column is bigger than 1:
If Not Application.Intersect(Target, Range("B2:B10")) Is Nothing Then
If Target.Column > 1 Then
Application.EnableEvents = False 'Prevents the Event from firing again when changing a value.
Target.Offset(0, -1).Value = Date
Application.EnableEvents = True
End If
End If
Also, without disabling the Events, changing a value inside the Change Event will trigger it again leading to a loop.
I am trying to write a program to do following steps:
When at cell M2, check the contents of all the cells before column
M in same row
In case any of the cells before column M in same row is empty, do
not allow user to enter any value in cell M2. RAther given a message
to user about empty data.
Creates a report in cell N2 of the missing data's (The first row of
excel is having headings of data contained in columns)
Problems encountered till now:
Indefinite loop - i think when clearing contents loop is triggered again that is causing this problem
I am not sure if the concatenate code is good or not.
Program below:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$M$2" Then
MsgBox "1"
Call MyMacro
End If
End Sub
Sub MyMacro()
'If [OR(ISBLANK(A2:L2))] Then
If ISBLANK(A2) Then
MsgBox "2"
Range("N2").Select
ActiveCell.Value = N2.Value + A1.Value
'Range("M2").ClearContents
'MsgBox "3"
'this the message that pops up if any cell in the range is blank
End If
End Sub
Thank you for your response in advance...
Another option,which doesn't use macros, is to use data validation in column M, with the custom formula
=counta(A2:L2)=12
and the custom Error message "Blank cells in columns A through L".
This of course doesn't give you the missing cells, but you could get the first one with this array formula (enter with ctrl+Shift+enter)
=IFERROR(ADDRESS(ROW(),MATCH(TRUE,A2:L2="",0)),"")
Something like this will
test for blanks (true blanks) in A2:L2 when M2 is changed
Turn Events off, to avoiding reloading the code if N2 is used
dump these offending cell range in N12 is there blanks
code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng1 As Range
If Intersect(Target, Range("M2")) Is Nothing Then Exit Sub
With Application
.EnableEvents = False
On Error Resume Next
Set rng1 = Range("A2:L2").Cells.SpecialCells(xlBlanks)
On Error GoTo 0
If Not rng1 Is Nothing Then
MsgBox "blank cells in " & rng1.Address(0, 0), vbCritical, "User entry in M2 removed"
[n2] = rng1.Address
[m2].Clear
End If
.EnableEvents = True
End With
End Sub