I have been using this code which copies the range and paste the range as picture but when i change the concerns cell it throws an error that is Error 1004, Microsoft Excel cannot paste the data.
Any help will be appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C5:P5")) Is Nothing Then
Application.CutCopyMode = TRUE
ActiveSheet.Pictures.Delete
Worksheets("Pivot").Range("FC3:FP35").Copy
With Worksheets("Map")
.Activate
.Range("C8").Select
.Pictures.Paste
End With
Application.CutCopyMode = FALSE
End If
End Sub
You need to turn off events Application.EnableEvents = False before changing cells and turn them on after. Make sure they get turned on in any case of an error in this event or you will not be able to fire any other events in your Excel instance. So error handling in this event is a must have. • You might benefit from reading
How to avoid using Select in Excel VBA.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("C5:P5")) Is Nothing Then
On Error Goto ERR_ENABLE_EVENTS
Application.EnableEvents = False
Me.Pictures.Delete
Worksheets("Pivot").Range("FC3:FP35").Copy Destination:=Worksheets("Map").Range("C8").Paste
End If
ERR_ENABLE_EVENTS:
Application.CutCopyMode = False
Application.EnableEvents = True
If Err.Number <> 0 Then
Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End If
End Sub
Related
I have problem with ClearContents in Worksheet_Change as it keep ClearContents of the range and doesn't allow me for data entry. i want ClearContents to done only one time
would you help me with that
the code I use below
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Range("A6") = "Semi Auto" Then
Range("E5:L5").ClearContents
Range("E6:L6").Formula = Range("E14:L14").Formula
End If
Application.EnableEvents = True
End Sub
This one will only trigger, if the change is concerning Range("A6"):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A6")) Is Nothing Then Exit Sub
If Range("A6") = "Semi Auto" Then
Range("E5:L5").ClearContents
End If
End Sub
A Worksheet Change
When you copy the code into the sheet module, the second solution will be 'active'. It is the Play solution, which you should use to explore how the Worksheet Change event behaves.
When done testing, delete it or rename it, and then rename the first, the Real solution, to Worksheet_Change without the 1.
This will only work if you're manually changing the values in A6, which also includes the change via dropdown or VBA code. If you have a formula in A6 this will not work.
The Code
Option Explicit
Private Sub Worksheet_Change1(ByVal Target As Range)
If Not Intersect(Target, Range("A6")) Is Nothing Then
If Not IsError(Range("A6")) Then
If Range("A6") = "Semi Auto" Then
Application.EnableEvents = False
On Error GoTo SafeExit
Range("E5:L5").ClearContents
Range("E6:L6").Formula = Range("E14:L14").Formula
On Error GoTo 0
Application.EnableEvents = True
End If
End If
End If
ProcExit:
Exit Sub
SafeExit:
Application.EnableEvents = True
GoTo ProcExit
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A6")) Is Nothing Then
If Not IsError(Range("A6")) Then
If Range("A6") = "Semi Auto" Then
MsgBox "Semi Auto."
Else
MsgBox "Not Semi Auto."
End If
Else
MsgBox "Is error value."
End If
Else
MsgBox "Not cell ""A6""."
End If
End Sub
Quick query about some VBA. I have recently moved from Excel 2003 to 2016 (365), and there are issues with transferring code.
I have a cell you input a number in. When you press enter after editing the cell, it adds that value to a cell 2 cells to the right, and keeps a tally. It then erases the value in the original cell.
Sub CasesChecked()
If Sheets("Work Return").Range("F13") = "" Then
Sheets("Work Return").Unprotect "adminstats"
Sheets("Work Return").Range("F13") = Sheets("Work Return").Range("D13")
Sheets("Work Return").Range("D13") = ""
Sheets("Work Return").Protect "adminstats"
Else
Sheets("Work Return").Unprotect "adminstats"
Sheets("Work Return").Range("F13") = Sheets("Work Return").Range("F13") + Sheets("Work Return").Range("D13")
Sheets("Work Return").Range("D13") = ""
Sheets("Work Return").Protect "adminstats"
End If
End Sub
The code above is found in Module1, and in Sheet1 there is the code below. This confirms the cell change through an intersect:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("D13")) Is Nothing Then
CasesChecked
Else
If Not Intersect(Target, Target.Worksheet.Range("D17")) Is Nothing Then
CasesChecked2
Else
End If
End If
End Sub
Unfortunately, I get the dreaded "run-time error '-2147417848 method range of object _worksheet failed" and can't quite figure out why. The code is simple, I don't know where it falters.
Any advice would be hugely appreciated
Thank you,
Ryan
I would first make this change and try again:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("D13")) Is Nothing Then
Application.EnableEvents = False
CasesChecked
Application.EnableEvents = True
Else
If Not Intersect(Target, Target.Worksheet.Range("D17")) Is Nothing Then
Application.EnableEvents = False
CasesChecked2
Application.EnableEvents = True
Else
End If
End If
End Sub
EDIT#1:
In the original code, Worksheet_Change() responded to user-initiated changes. But it also responded to changes made by CasesChecked().
This created a malicious loop. The new code avoids this.
I'm receiving a type 13 mismatch error with Excel VBA. This script checks two columns and locks cells in a column once a change is made, or doesn't lock it if the user clicks the cell and clicks off without any changes. Line 5 is apparently the culprit. Any help is much appreciated.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range
Set A = Union(Range("I:I"), Range("J:J"))
If Intersect(Target, A) Is Nothing Then Exit Sub
If Target.Value = "" Then Exit Sub
ActiveSheet.Unprotect Password:="YourPassword"
Target.Locked = True
ActiveSheet.Protect Password:="YourPassword"
End Sub
Target is the cell or cells that have been changed. If Target is more than a single cell (e.g. pasted block of values, etc) then Target does not have a .Value. Add If Target.Count > 1 Then Exit Sub to the top of the code or loop through Target, examining each cell within Target for the .Value.
Example of the latter,
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Union(Range("I:I"), Range("J:J"))) Is Nothing Then
On Error GoTo bm_Safe_Exit
ActiveSheet.Unprotect Password:="YourPassword"
Application.EnableEvents = True
Dim ij As Range
For Each ij In Intersect(Target, Union(Range("I:I"), Range("J:J")))
If ij.Value <> "" Then
ij.Locked = True
End If
Next ij
End If
bm_Safe_Exit:
ActiveSheet.Protect Password:="YourPassword"
Application.EnableEvents = True
End Sub
Additionally, it is not considered a 'best practise' to use the ActiveSheet property in a Worksheet_Change event macro.
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Does the validation range still have validation?
If Not HasValidation(Range("A1:A1048576")) Then RestoreValidation
If Not HasValidation(Range("C1:C1048576")) Then RestoreValidation
If Not HasValidation(Range("I1:I1048576")) Then RestoreValidation
If Not HasValidation(Range("P1:P1048576")) Then RestoreValidation
End Sub
Private Sub RestoreValidation()
Application.EnableEvents = False
'turn off events so this routine is not continuously fired
Application.Undo
Application.EnableEvents = True
'and turn them on again so we can catch the change next time
MsgBox "Your last operation was canceled." & _
"It would have deleted data validation rules.", vbCritical
End Sub
Private Function HasValidation(r) As Boolean
' Returns True if every cell in Range r uses Data Validation
On Error Resume Next
Debug.Print r.Validation.Type 'don't care about result, just possible error
If Err.Number = 0 Then HasValidation = True Else HasValidation = False
End Function
I applied validation on 4 columns with the above code, Even the validation is passed I am getting 4 error pop up messages how to restrict number of error messages ?
UPDATE:
I selected the value from the drop down which is a valid selection, but I am getting the below error message.
I am using the following code
If you are working with the sheet's Change event, then I would recommend having a look at THIS
Since you are working with just one sheet then you don't need the code in the ThisWorkbook code area. If you put it there then the code will run for every sheet. Put the code in the relevant sheet's code area. So if the validation is in Sheet1 then put the code in the Sheet1 code area. See ScreenShot below.
Ok now to address your query. What you can do is use a Boolean variable and then set it to True after you show the first message so that the message doesn't show again.
Try this (UNTESTED)
Dim boolDontShowAgain As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
If Not HasValidation(Range("A1:A1048576")) Then RestoreValidation
If Not HasValidation(Range("C1:C1048576")) Then RestoreValidation
If Not HasValidation(Range("I1:I1048576")) Then RestoreValidation
If Not HasValidation(Range("P1:P1048576")) Then RestoreValidation
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
Private Sub RestoreValidation()
Application.Undo
If boolDontShowAgain = False Then
MsgBox "Your last operation was canceled." & _
"It would have deleted data validation rules.", vbCritical
boolDontShowAgain = True
End If
End Sub
Private Function HasValidation(r) As Boolean
On Error Resume Next
Debug.Print r.Validation.Type
If Err.Number = 0 Then HasValidation = True
End Function
After some googling I finally found some code where I could prevent users from placing formulas inside cells. It works great, that's until I protected the sheet. Can anyone tell me what I'm doing wrong? I'm really new to VB.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
On Error Resume Next
Range("I39").SpecialCells(xlCellTypeFormulas).ClearContents
On Error GoTo 0
Application.EnableEvents = True
End If
End Sub
The entire code for my sub is as follows. I need to stop users from pasting in the cells and putting formulas in them.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("C26")) Is Nothing Then
Application.CutCopyMode = True
Application.EnableEvents = False
On Error Resume Next
Range("C26").SpecialCells(xlCellTypeFormulas).ClearContents
On Error GoTo 0
Application.EnableEvents = True
End If
End Sub
Here is a version that facilitates formula checking over a range of cells:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rNoFormulas As Range
Set rNoFormulas = Range("C26:I26")
If Intersect(Target, rNoFormulas) Is Nothing Then Exit Sub
If Target.HasFormula Then
Application.EnableEvents = False
Target.ClearContents
MsgBox "formulas not allowed in cell " & Target.Address
Target.Select
Application.EnableEvents = True
End If
End Sub
If you want to allow data entry in cell C26, but not formula entry, then use the Change Event:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rNoFormulas As Range
Set rNoFormulas = Range("C26")
If Intersect(Target, rNoFormulas) Is Nothing Then Exit Sub
If rNoFormulas.HasFormula Then
Application.EnableEvents = False
rNoFormulas.ClearContents
MsgBox "formulas not allowed in cell C26"
rNoFormulas.Select
Application.EnableEvents = True
End If
End Sub
If you just want to protect certain cells only, no vba code is need.
follow this step :
Open sheet that contains cells or columns that you want to protect, press ctrl while selecting those cells or column to be protect, then right click, choose format cells, choose protection tab and uncheck the locked option. those cells or column will not be locked although you have protected the sheet. default setting is all cells in the sheets is locked so you must choose which cells you want to unlock while protecting the sheet. you may record a macro if you still want to use vba. hope this help