Worksheet_change doesn't seem to trigger - vba

I have a macro up and running that sorts a pivot table, copies a range of cells out of the table and then pastes those into a second sheet. To be honest, with where I'm at with VBA right now I'm pretty happy with this feat alone. Yet I have more things I want it to do.
What I want to happen is this: The macro I have pastes data into the first empty cells in column A. When this happens I want the macro to enter today's date (preferably in a manner that makes it permanent and won't change to tomorrow's date tomorrow) in the same row in column C and the text "IV020" into column D.
In Sheet9 I have the following code (mainly taken from posts here):
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim aCell As Range
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Columns(1)) Is Nothing Then
If Not Target.Columns.Count > 1 Then
For Each aCell In Target
If aCell.Value <> "" And aCell.Offset(0, 2).NumberFormat = "" Then
aCell.Offset(0, 2).Value = "=TODAY()"
aCell.Offset(0, 3).Value = "IV020"
End If
Next
Else
MsgBox "Please paste in 1 Column"
End If
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
Yet when things are pasted or entered manually into Column A, nothing happens.

You cannot have a Range.NumberFormat property that is a zero-length string. Even if you tried to put one in manually, it would reset itself to General.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns(1)) Is Nothing Then
'don't do things until you have to
On Error GoTo Whoa
Application.EnableEvents = False
Dim aCell As Range
'this processes all of the cells that were changes in column A
For Each aCell In Intersect(Target, Columns(1))
'If aCell.Value <> "" And aCell.Offset(0, 2).NumberFormat = "" Then
If aCell.Value <> "" Then
aCell.Offset(0, 2).Value = Date 'possibly Now but likely not "=TODAY()"
aCell.Offset(0, 3).Value = "IV020"
End If
Next
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
I've made some minor changes; you will have to decide what you want to do about the .NumberFormat issue.

Related

Change cell if other cell contains text vba

I used to have the following code and it used to work but for some reason it no longer works.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim test As Range
Dim KeyCells As Range
Dim i As String
Set KeyCells = Range("AF3:AF5000")
test = Target.Rows.Count
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
For i = Target.Row To (Target.Row + (Target.Rows.Count - 1))
If Not ActiveSheet.Cells(i, 32) = "" Then
ActiveSheet.Cells(i, 20).Value = "Closed"
End If
Next
End If
End sub
Basically if there is data in any cells of column AF then the cell align with the information in column T would mark Closed. For example if AF65 <>"" then T65.value ="Closed"
Any idea why it no longer works or if there is another possibility for a macro?
Get rid of the redundant code and non-specific worksheet references. For example, a Worksheet_Change can be triggered when that worksheet is not the Activesheet; putting in Activesheet when it is not required only confuses the issue.
You also are not disabling events so your sub is going to try to run on top of itself.
This should be closer to what you are attempting to perform.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("AF3:AF5000"), Target.Parent.UsedRange) Is Nothing Then
On Error GoTo safe_exit
Application.EnableEvents = False
Dim trgt As Range
For Each trgt In Intersect(Target, Range("AF3:AF5000"), Target.Parent.UsedRange)
If CBool(Len(trgt.Value2)) Then
trgt.Offset(0, -12) = "Closed"
Else
trgt.Offset(0, -12) = vbNullString
End If
Next trgt
End If
safe_exit:
Application.EnableEvents = True
End Sub
If your original sub just 'stopped working' then put Application.EnableEvents = True into the VBE's Immediate window and tap [enter]. It is possible that your earlier code crashed with event handling disabled.

Runtime 1004 Workaround - Protect/Unprotect in Worksheet_Change

I've read a few others which partially resolved my issue but being a complete VB amateur I can't get this to work. The worksheet in question is protected so have tried adding in a protect/unprotect command in the code. It will unprotect fine at the start but then encounters problems. Any help would be appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
Sheet1.Unprotect Password:="mypassword"
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("B11")) Is Nothing Then
Select Case Target.Value
Case Is = ""
Target.Value = "Product Name (IE Product123)"
Target.Font.ColorIndex = 15
Case Else
Target.Font.ColorIndex = 1
End Select
End If
If Not Intersect(Target, Range("B12")) Is Nothing Then
Select Case Target.Value
Case Is = ""
Target.Value = "Version "
Target.Font.ColorIndex = 15
Case Else
Target.Font.ColorIndex = 1
End Select
End If
Sheet1.Protect Password:="mypassword"
End Sub
You have not turned off the Application.EnableEvents property but there is a chance that you will write something to the worksheet. This would retrigger the event handler and the Worksheet_Change event macro would try to run on top of itself.
There is nothing preventing someone from simultaneously clearing the contents of both B11 and B12. Rather than abandoning the processing, accommodate the possibility and process both cells if there are two cells in target.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B11:B12")) Is Nothing Then
On Error GoTo bm_Safe_Exit
'turn off event handling 'cause we might write something
Application.EnableEvents = False
'why this unprotect necessary??
'Me.Unprotect Password:="mypassword"
Dim rng As Range
For Each rng In Intersect(Target, Range("B11:B12"))
Select Case rng.Value2
Case vbNullString
If rng.Address(0, 0) = "B11" Then
rng = "Product Name (IE Product123)"
Else
rng = "Version " '<~~ why the trailing space??
End If
rng.Font.ColorIndex = 15
Case Else
rng.Font.ColorIndex = 1
End Select
Next rng
End If
bm_Safe_Exit:
'if unprotect is not necessary, neither is protect
'Me.Protect Password:="mypassword"
Application.EnableEvents = True
End Sub
You might also want to look into the UserInterfaceOnly parameter of the Worksheet.Protect method. Setting this to true allows you to do anything you want in VBA without unprotecting the worksheet.
Addendumm:
If the user can alter the contents of B11:B12 then these cells must not be locked. If they are not locked then there is no need to unprotect the worksheet before (possibly) altering their contents.

Excel spreadsheet VBA code not working all the way

The code that is running on my excel spreadsheet that I am working on is working fine, expect for when I copy and import information into the protected cells it gives me a type mismatch error and can not figure out how to fix the code.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Range("C1:C20")) Is Nothing Then
If Len(Trim(Target.Value)) = 0 Then Application.Undo
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
When you paste a number of values into two or more cells within the C1:C20 range, the Target is more than 1 and you cannot use the Range.Value property of Target.
Typically, you would use something like the following.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C1:C20")) Is Nothing Then
'do not do anything until you know you are going to need it
On Error GoTo Whoa
Application.EnableEvents = False
Dim crng As Range
'in the event of a paste, Target may be multiple cells
'deal with each changed cell individually
For Each crng In Intersect(Target, Range("C1:C20"))
If Len(Trim(crng.Value)) = 0 Then Application.Undo
'the above undoes all of the changes; not just the indivual cell with a zero
Next crng
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
However, your desire to use Application.Undo presents some unique problems because you do not want to undo all of the changes; just the ones that result in zero. Here is a possible solution.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C1:C20")) Is Nothing Then
'do not do anything until you know you are going to need it
On Error GoTo Whoa
Application.EnableEvents = False
Dim c As Long, crng As Range, vals As Variant, prevals As Variant
'store the current values
vals = Range("C1:C20").Value2
'get the pre-change values back
Application.Undo
prevals = Range("C1:C20").Value2
'in the event of a paste, Target may be multiple cells
'deal with each changed cell individually
For c = LBound(vals, 1) To UBound(vals, 1)
If vals(c, 1) = 0 Then vals(c, 1) = prevals(c, 1)
Next c
Range("C1:C20") = vals
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
The new values are stored in a variant array and then the paste is undone. The old values are stored in another variant array. The new values are walked through and if a zero comes up, it is replaced with the old value. Finally, the revised set of new values is pasted back into the C1:C20 range.
Your sheet must be protected, so you need to unprotect your sheet first:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Sheets("NameOfYourSheet").Unprotect Password:="YourPassWord" ' Change the name of the sheet which is locked
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Range("C1:C20")) Is Nothing Then
If Len(Trim(Target.Value)) = 0 Then Application.Undo
End If
Sheets("NameOfYourSheet").Protect Password:="YourPassWord"
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub

Protecting a Sheet - While allowing changes via a double click

I am creating a spreadsheet where people are to enter when something has been completed. I figured the most efficient way would be to use double click tick boxes. However, I want to pull the user ID and the timestamp for this, and don't want anyone to be able to edit anything except if they are double clicking something for the first time.
I have the below which works for what I need but I don't know how to protect the sheet exactly as I wish.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Limit Target count to 1
If Target.Count > 1 Then Exit Sub
'Isolate Target to a specific range
If Intersect(Target, Range("Ckboxes")) Is Nothing Then Exit Sub
'Set Target font to "marlett"
Target.Font.Name = "marlett"
'Check value of target
If Target.Value <> "a" Then
Target.Value = "a" 'Sets target Value = "a"
Target.Offset(0, 1).Value = Environ("UserName")
Target.Offset(0, 2).Value = Format(Now, "yyyy-mm-dd hh:mm:ss")
Cancel = True
Exit Sub
End If
If Target.Value = "a" Then
Cancel = True
Exit Sub
End If
End Sub
Also, if I protect columns C and D then it won't let the macro enter the values needed there. I know I may need to protect the whole worksheet and have it unlock the cells upon a double click to allow the change to happen and then lock again straight after but I can't figure out how to manage that!
Any help is appreciated!
What you could do is protect the sheet as usual and put in the check-boxes. Then assign this macro to all the checkboxes -
Sub ChkBxClk()
Dim shp As Shape
Set shp = ActiveSheet.Shapes(Application.Caller)
If shp.ControlFormat.Value = xlOff Then
MsgBox ("This was already checked off")
shp.ControlFormat.Value = xlOn
Exit Sub
End If
If shp.ControlFormat.Value = xlOn Then
ActiveSheet.Unprotect
Dim rng As Range
Set rng = Range(shp.TopLeftCell.Address)
rng.Offset(0, 1).value = Environ("UserName")
rng.Offset(0, 2).value = Format(Now, "yyyy-mm-dd hh:mm:ss")
ActiveSheet.Protect
End If
End Sub
Now, if a user checks a box (which is allowed on a protected sheet), it will unlock and allow you to enter what you want in the offset cells.

How to disable changes in a cell using vba?

I am working with the bellow code:
This code do for Example: If I input any value in cell A1, cell B1 display a time stamp.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("B1:B10"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
With .Offset(0, 1)
.NumberFormat = "hh:mm AM/PM"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
What I am trying to do now is to protect/not editable from the user the cell "B1:B10" once time stamp has made by the macro. I google on how to protect but I am having hard time to insert those code I found. Can anyone help me how I construct/insert this code to my original code?
Private Sub Worksheet_Change(ByVal Target As Range)
'set your criteria here
If Target.Column = 1 Then
'must disable events if you change the sheet as it will
'continually trigger the change event
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
MsgBox "You cannot do that!"
End If
End Sub
Or this code:
'select the cell you want to be editable
Worksheets("Sheet1").Range("B2:C3").Locked = False
'then protect the entire sheet but still vba program can modify instead.
Worksheets("Sheet1").Protect UserInterfaceOnly:=True
Thanks to Kazjaw. Here is the final code.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Protect cell "B1:B10"
Worksheets("Sheet1").Cells.Locked = False
Worksheets("Sheet1").Range("B1:b10").Locked = True
Worksheets("Sheet1").Protect Password:="pass", UserInterfaceOnly:=Tru
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("B1:B10"), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
With .Offset(0, 1)
.NumberFormat = "hh:mm AM/PM"
.Value = Now
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
If you want to protect only Range B1:B10 then you need to run this sub only once:
Sub ProtectCellsInB()
Worksheets("Sheet1").Cells.Locked = False
Worksheets("Sheet1").Range("B1:b10").Locked = True
Worksheets("Sheet1").Protect Password:="pass", UserInterfaceOnly:=True
End Sub
I made a modification- I added a password to protection which you can delete.
If you are not sure how to run it once then you could add the whole internal code at the end of your Private Sub Worksheet_Change(ByVal Target As Excel.Range)