I have a series of data, running from cells C169:N174, sourcing a line chart. Cell data is either a number, or empty (Excel empty) - the formula returns either the number or blank text ("").
When the action is triggered, via data validation, I need the formulas in the right-most cells (N169:N174) copied left through C169:C174). To accomplish this, I have this code:
Range("N169:N174").AutoFill Destination:=Range("C169:N174")
Range("C169:N174").Select
After the formulas are copied, I need any cell containing text (""), to be cleared. To accomplish this, I have this code:
Range("C169:M174").SpecialCells(xlCellTypeFormulas, 2).Select
Selection.ClearContents
This code runs for two sets of data. Same code, different cells. Ranges are C169:N174 and C145:N150. I have the code written for range1 (C145:N15) first - formulas copy then cells w/ ("") deleted. Then same action for range2 (C169:N174). Full code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Address = "$B$2" Then
'mcroCopyTrendedRentFormulas
Range("N145:N150").AutoFill Destination:=Range("C145:N150"), Type:=xlFillDefault
Range("C145:N150").Select
'mcroClearTrendedRentEmptyCells
Range("C145:N150").SpecialCells(xlCellTypeFormulas, 2).Select
Selection.ClearContents
'mcroCopyAskingRentFormulas
Range("N169:N174").AutoFill Destination:=Range("C169:M174")
Range("C169:N174").Select
'mcroClearAskingRentEmptyCells
Range("C169:M174").SpecialCells(xlCellTypeFormulas, 2).Select
Selection.ClearContents
Range("A1").Select
End If
End Sub
Once the code is triggered, if I click anywhere on the sheet before it has finished running, which I just timed and it took 45 seconds, I get an error saying either:
"1004 Error: No cells were found"
or
"1004 Error: AutoFill method of Range class failed".
If I let the code run the entire 45 seconds, it works. If I click anywhere in the sheet and get either error, stop the debugger and try to run it again, I get one of the two errors.
So maybe speeding up execution is the issue?
I don't know - open to anything here.
I slightly edited the code, mainly removing superfluous .Select lines (well, commented them out) and combined .Select and .ClearContents. This should run a little faster. Note the use of ScreenUpdating and Calculation.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$2" Then
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'mcroCopyTrendedRentFormulas
Range("N145:N150").AutoFill Destination:=Range("C145:N150"), Type:=xlFillDefault
'Range("C145:N150").Select
'mcroClearTrendedRentEmptyCells
Range("C145:N150").SpecialCells(xlCellTypeFormulas).ClearContents
'mcroCopyAskingRentFormulas
Range("N169:N174").AutoFill Destination:=Range("C169:M174")
'Range("C169:N174").Select
'mcroClearAskingRentEmptyCells
Range("C169:M174").SpecialCells(xlCellTypeFormulas).ClearContents
Range("A1").Select
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
I also removed the 2 from your SpecialCells() as I don't believe that's required, and was throwing an error for me as well until I removed it.
While this is running, let it run without clicking. Really while any Macro is running in Excel, it's best to just let it sit and run.
Related
I want Excel to calculate the sheet, every time the user enters a value (source1 source2):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Worksheet("Calc").Range("R1:R100")
MsgBox "Check!"
Application.EnableEvents = False
If Not Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
' Display a message when one of the designated cells has been changed.
MsgBox "Cell " & Target.Address & " has changed."
'Calculate
Sheets("Calc").Calculate
End If
Application.EnableEvents = True
End Sub
The sheet does not get recalculated after entry of value. Even, the message box "Check!" never appears. - Why is that?
(For info: I can only guess that it has something to do with my setting the calculation to "manual":
I have a sheet in Workbook "B.xlsm" with circular references, hence I run a script from Workbook "A.xlsm", from where I open Workbook "B.xlsm":
Application.Calculation = xlManual
[...]
Set wb = Workbooks.Open(strPath)
Is there a way to get this method "Change" to work with manual calculation?)
I think Tim nailed it.
At some point in testing the code, the code stopped; Either from and Run-time Error or manually stepping through line-by-line. In either case, you probably changed something which forced it to reset and it never had a chance to run the most important line...Application.EnableEvents = True.
Disabling Events is a persistent state.
It's very wise to make sure that you have error handling working to restore it, if other users are going to be using your code. Unfortunately, you'll still break it while testing.
I use the following routine (at the top of the main module) to fix it, when this happens:
Public Sub FixIt()
Application.EnableEvents = True
If Not ActiveWindow Is Nothing Then Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
In fact, I usually call this routine as the first line of any button I have on the Ribbon/Sheet, just to make sure that everything is working like it should be.
In your case, you could omit the Application.Calculation line, or set it equal to xlManual
I'm running a target intersect method in excel to prevent a user from pasting over validation cells, problem is, I didn't account for all the paste methods, and pastespecial overrides the cell validations.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("I14:J1000")) Is Nothing Then
On Error Resume Next ' In case there's been no previous action
' Check if the last action was a paste
If Left(Application.CommandBars("Standard").Controls("&Undo").List(1), 5) = "Paste" Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
End If
End Sub
I used the code below and binded it to Ctrl V, so that it matches the destination formatting, but it overrides the cell validation from the previous code:
Sub PasteWithDestinationFormatting()
ActiveCell.PasteSpecial (xlPasteValues)
End Sub
I'm assuming I need to change ="Paste" to a "PasteSpecial" but it didn't accomplish what I wanted it to do, most likely cause I didn't have the correct location of the PasteSpecial object.
Thanks for the help!
I have a Macros enabled workbook(protected sheets).
Users are allowed to provide the inputs to the cells that are unlocked.
The problem here is when users copy paste the data from other applications, it will overwrite the format used on an existing sheet, which is creating a hassle.
Is it possible to keep the format even when users copy/paste?
1) Create custom styles for various formatting used on your sheet and (if possible) name ranges which are "styled"
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("STYLE")).Count = Target.Count Then
Target.Style = "STYLE"
End If
End Sub
This code will check, if changed cells are "inside" of styled range. If all changed cells are inside the styled range - apply the style. If you keep the range naming consistent with style naming you can use a loop to go through.
The following code worked for me. It recognizes if someone pastes into the range of cells, undoes the paste, and repastes matching the destination formatting
If Not Intersect(Target, Range("A1:D12")) Is Nothing Then
If Application.CommandBars("Standard").Controls("&Undo").Enabled = True Then
Dim UndoString As String
UndoString = Application.CommandBars("Standard").Controls("&Undo").List(1)
If Left(UndoString, 5) = "Paste" Then
Application.EnableEvents = False
Application.Undo
Target.Select
ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
Application.EnableEvents = True
End If
End If
End If
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 have an Excel like shown below which is a sharedExcel.
Now i should not allow paste option for the rows which have backcolour as GRAY(These are not fixed at runtime any row may get GRAY colour). As it sharedExcel and i can't use the Lock property. Any help wouls be appreciated greatly.
Using a color as a property that is used to check true / false is bad behaviour.
You can get around this by for example adding a column (hidden if needed) with 0 / 1 or TRUE / FALSE which you make accessible by for example a combobox (then you can still adapt the color into gray by clicking this cbb box).
The you can check on a dynamically composed range via a Sheet event on_Change.
The basic syntax for the sheet event:
Private Sub Worksheet_Change(ByVal Target As Range)
'Set range dynamically instead of this hard coded example
If Not Intersect(Target, Thisworkbook.Sheets(1).Range("A1:A10")) Is Nothing Then
'Do something
End If
End Sub
After spending some time on this problem i have coded following lines. It work's fine. Here i have taken another spreadsheet called PasteSheet for coding purpose but i am not showing it to user at any moment.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Application.CutCopyMode Then
SelectedRow = ActiveCell.Row
With Sheets("PasteSheet")
.Activate
.Range("A1").PasteSpecial xlPasteValues
CR = Selection.Rows.Count
End With
Worksheets("ActualSheet").Activate
For k = SelectedRow To (SelectedRow + CR)
If Worksheets("ActualSheet").Cells(k, 30).Interior.Color = RGB(215, 215, 215) Then
Application.EnableEvents = False
MsgBox "Pasting is not allowed here!"
'Clearing data in PasteSheet
Worksheets("PasteSheet").Cells.ClearContents
Worksheets("ActualSheet").Activate
Application.EnableEvents = True
Exit Sub
End If
Next
End If
End Sub