I have been working on debugging this code and I am running into an issue where the code runs fine (no errors) but the changes it is supposed to be making aren't happening in the actual sheet.
What the code is supposed to do:
The goal is to be able to check on saving if any cells have been changed. If they have, it locks all cells with non-blank values and protects the sheet to avoid having those cells edited in future instances.
Here is the code itself:
Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim sMSG As String
sMSG = "Saving the workbook will lock the cells you have entered data into." & vbLf
sMSG = sMSG & "Do you want to go ahead?"
If Not bRangeEdited Then GoTo Xit
If Not Me.ReadOnly Then
Sheet1.Unprotect "password"
With Sheet1.Range("A1:I20")
If MsgBox(sMSG, vbExclamation + vbYesNo) = vbNo Then
Cancel = True
GoTo Xit
End If
If .SpecialCells(xlCellTypeBlanks).Address <> .Address Then
.SpecialCells(xlCellTypeConstants).Locked = True
bRangeEdited = False
End If
End With
Sheet1.Protect Password:="password", UserInterFaceOnly:=True, DrawingObjects:=False, AllowFiltering:=True
End If
Xit:
End Sub
This is based on a common piece of code found on multiple forums which seems to work for everyone else. This code USED to work and then something broke it. I thought it was the Range being wrong (which I fixed) but that didn't solve the problem.
What I've tried:
Running the separate code lines in the Immediate window - everything runs properly
Stepping through the code with F8 and debug.print to check what is being pulled by .SpecialCells(xlCellTypeBlanks).Address - this pulls the entire input range every time, regardless of what is in the cells but pulls the correct range when run in the Immediate window
Stepping through also produces no errors and shows that every if and with statement is working correctly
Running the code from different locations (Sheet1, Module, ThisWorkbook) including separating into multiple subs across different locations - no change
Running the code on a brand-new test workbook with no other macros - still doesn't work
Different methods for locking the cells such as a loop through all cells in the range instead of using SpecialCells - didn't work
Even the Protect/Unprotect lines are not working which leads me to believe that the code is somehow disconnected from the worksheet itself.
Anyone have any ideas how that is possible? Or how to fix it?
Related
I've read various posts about using VBA to prevent format changes to spreadsheets caused by the user pasting data.
I didn't like the approaches binding CTRL+V to a macro because the user may not use the shortcut, and some examples had the effect of pasting into any cell that was subsequently clicked on.
I've had most success with the code from https://www.mrexcel.com/board/threads/vba-for-pastespecial-values-only.355553/ which uses the undo function. This works (although it's a little slow) for copy and paste within the workbook, and with single or multiple cells, but not from other instances of Excel or other programs.
I found Excel vba paste special method fails whenever i try to paste which works with pastes into a single cell.
Is there a way to combine the two and achieve the aim of preventing paste from any source changing cell(s) formatting?
I think I've written something useful that seems to work well for me.
I didn't implement your suggestion as it seemed fairly complex, and I found another forum post with a slightly different form of the 'undo' based scripts that worked well for copy and paste of text or single cells, or ranges from within an instance of excel or from external programs. I've combined that with the more common version I'd found which deals with 'Auto Fill' events too, and I've added some other little enhancements.
I've acknolwedged the other forum posts which I used too. Here it is in case it is of use to other people. I'm not an expert and I expect the code could be improved, but it does what I need.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'Prevents user changing cell formatting by undoing the paste and pasting the value only without formatting
'Macro restricted to run on paste events to prevent the pasting of formats into the spreasheet, but not run on delete or type events
'Works with ranges and individual cells, both within the workbook Excel instance and from other instances or external programs
'A combination of:
'https://www.mrexcel.com/board/threads/force-paste-special-values.230718/
'https://stackoverflow.com/questions/45135039/excel-vba-code-to-force-values-only-paste-causes-strange-behavior-when-pasting-o
'And:
'https://answers.microsoft.com/en-us/msoffice/forum/all/how-do-you-lock-formats-but-allow-data-entry/afccc43e-e191-417f-826c-d10a464a1b9a?page=4
'A disadvantage of many macros, including this one, is that the undo history is cleared
'Macro can be disabled for spreadsheet developement by changing the Devel value used in the first IF statement of the macro
Dim Devel As Boolean
Devel = "False" 'Remember to set back to False after spreadsheet development work
If Devel = "False" Then
'In normal user mode, prevent pastes etc from changing formatting
Dim SavedVal As Variant
Dim UndoString As String
Dim srce As Range
On Error GoTo ErrHan
'Detect 'Paste' and 'Auto Fill' events in the undo list and only continue macro if these are found
UndoString = Application.CommandBars("Standard").Controls("&Undo").List(1) 'This always gives an error on spreadsheet open as the undo list is empty, but the error handling deals with it
If Left(UndoString, 5) <> "Paste" And UndoString <> "Auto Fill" Then
Exit Sub
End If
'Save the pasted value for later. This form and the use of type Variant is important in the flexibility of this macro
SavedVal = Target.Value
'Switch off events to prevent infinite loop
Application.EnableEvents = False
'Switch off screen updates
Application.ScreenUpdating = False
'Undo the user's paste
Application.Undo
'Handle 'Auto Fill' events differently. These can use the Target.PasteSpecial approach
If UndoString = "Auto Fill" Then
Set srce = Selection
srce.Copy
Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.SendKeys "{ESC}"
Union(Target, srce).Select
Else
'Set target value. This form works with all selected data which the Target.PasteSpecial approaches don't
Target.Value = SavedVal
End If
Else
'In Devel mode so the developer can unlock the spreadsheet and change formats when pasting
End If
ErrExit:
'Remember to re-enable events
Application.EnableEvents = True
'Re-enable screen updates
Application.ScreenUpdating = True
Exit Sub
ErrHan:
Resume ErrExit
End Sub
when using the below code my excel freezes with no error (i have to pause code and end to allow excel to be used again. - the weird thing is i can run each of the updates individually and it wll work fine. but when all of them are active it stops working.
any advice?
Private Sub Worksheet_Change(ByVal Target As Range)
With ThisWorkbook
Dim Country As String
Country = .Sheets("Views").Range("C2").Text
Select Case Country
Case Is = "Australia"
.Sheets("Views").Range("C5").Formula = "=Volume!B7+Volume!H7+Volume!N7+Volume!T7+Volume!Z7+Volume!AF7"
.Sheets("Views").Range("C6").Formula = "=Volume!C7+Volume!I7+Volume!O7+Volume!U7+Volume!AA7+Volume!AG7"
.Sheets("Views").Range("C7").Formula = "=Volume!D7+Volume!J7+Volume!P7+Volume!V7+Volume!AB7+Volume!AH7"
.Sheets("Views").Range("C8").Formula = "=Volume!E7+Volume!K7+Volume!Q7+Volume!W7+Volume!AC7+Volume!AF7"
Case Is = "China"
'do china
End Select
End With
End Sub
thanks Variatus, you were 100% correct.
Presuming that the code is in the code sheet of Sheets("Views") the Change event, once triggered, would cause Change events by the changes it creates on the sheet, resulting in an endless loop which would, probably, eventually end in "out of memory". To avoid that, set Application.EnableEvents = False before any changes are made and set the property back to True after all changes have been completed. – yesterday
I also found that adding the following at the start also helped, this way the code only trigered updates when the specific Cell i wanted changed was changed i.e. the Country selection
If Not Application.Intersect(Range("C2"), Range(Target.Address)) Is Nothing Then
'code you want exicuted
End If
I have a worksheet_change macro embedded in two sheets within my workbook. They are there to prevent anyone making changes to the sheets. However, I still want the data within the sheets to be refreshed every so often. This does not work.
Two sheets within the workbook are connected via a query to another workbook. Essentially those sheets are a copy of the sheets within the other workbook.
I have embedded Code1 into the two worksheets. This is to prevent anyone making changes to the worksheet but still allow them to view the sheet and copy data from it. It brings up an message box and then undoes the change made by the user. This works fine and I am happy with it.
At the same time I want to be able to refresh the workbook so that the connected sheets are up to date with respect to the other workbook that they are connected to.
To do this I have added a button into the workbook called "Refresh". This button calls Code2. This was done with the intention of disabling events so that the worksheet_change macro is paused to allow for the data to be refreshed.
However, this does not work as the worksheet_change macro still works. I.e after clicking the button, the workbook is refreshed and then any update is undone and the message box is displayed - which isn't what I need.
CODE1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("A1:Z1000")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
MsgBox "DO NOT MODIFY THIS SHEET - Any necessary modifications should be made in 'Master Invoice Template' and this sheet will automatically be updated!"
End If
End Sub
CODE2
Sub refresh()
On Error GoTo ErrorHandler
Application.EnableEvents = False
ThisWorkbook.RefreshAll
ErrorHandler:
Application.EnableEvents = True
End Sub
I have scoured the internet for a solution and pretty much everything that I find points me in the direction of enableevents=false, but as described in my post this does not work. Do I need to change the method of solving my problem or am I doing something wrong within my code?
I suspect the undo line of code is causing the problem, but I am not sure!
Any help would be greatly appreciated!
I think I have figured out what was wrong with the code; correct me if I am wrong. The data was taking too long to refresh when Code2 was ran. This meant that the Application.EnableEvents = Ture in Code2 took effect before the data could be fully refreshed and when it finally did complete its update, the Worksheet_Change event was triggered.
I tried using DoEvents after the RefreshAll command but this didn't work either. I have used what I found in this post to work around the problem and the refresh button now works!
Specifically the code that helped is below: I replaced Code2 with this:
Sub Refresh_All_Data_Connections()
For Each objConnection In ThisWorkbook.Connections
'Get current background-refresh value
bBackground = objConnection.OLEDBConnection.BackgroundQuery
'Temporarily disable background-refresh
objConnection.OLEDBConnection.BackgroundQuery = False
'Refresh this connection
objConnection.Refresh
'Set background-refresh value back to original value
objConnection.OLEDBConnection.BackgroundQuery = bBackground
Next
MsgBox "Finished refreshing all data connections"
End Sub
Please let me know if my logic in explaining why the code didn't work is correct - I am still new to VBA and would like to understand the problem fully!
Apologies if this question is elementary, i'm not great at VBA. I have 3 separate codes that i want to run one after the other at the click of a button. So i have the master code titled UpdateLinks that is supposed to call them. The first 2 (PreSelect & UpdateLinksCode)run the 3rd (PostSelect) doesn't. Individually they all work.
The purpose is to update links to external excel workbooks without having to manually enter the password. That is what the UpdateLinksCode macro is for. However, if the linked source does not require a password the UpdateLinksCode will drop the password in whatever cell was selected before running. Hence the PreSelect & PostSelect - supposed to delete the password and prevent exposure.
This is the master code:
Sub UpdateLinks()
Call PreSelect
Call UpDateLinksCode
Call PostSelect
End Sub
The individual ones are as below:
Sub PreSelect()
Sheets("Sheet1").Select
Range("A1").Select
End Sub
Sub UpDateLinksCode()
Const PWord As String = "password"
Dim xlLinks
Dim i As Integer
xlLinks = ThisWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(xlLinks) Then
For i = 1 To UBound(xlLinks)
SendKeys PWord & "{Enter}"
ThisWorkbook.UpdateLink Name:=xlLinks(i)
Next i
End If
End Sub
Sub PostSelect()
Sheets("Sheet1").Select
Range("A1").Select
Selection.ClearContents
End Sub
It seems simple but i can't hack it.
Update: Appreciate all the input. I've now changed the code to sit in a module and refer to the worksheet by name. I've removed the call functions and separate codes and condensed it to the one. There are no errors when debugging or running through step by step.
However, same issue exists in that no further code will run following the 'send keys''. The "Range("A1").Select" needs to be in there because, something to do with the timing of the password request box popping up and the send keys inputting the password, causes half of the password to be typed into whichever cell is highlighted when the code is run. Therefore, i force it into cell A1 which has both background and text set to white.
Current code is as below:
Sub Update_links()
Worksheets("Staff Rota 2019").Unprotect "broncko"
Range("A1").Select
Dim PWord As String
PWord = "stevefinnan"
SendKeys PWord & "{Enter}"
ActiveWorkbook.UpdateLink Name:= _
"Y:\a - Staff Rota\Staff Rota 2019.xlsm", _
Type:=xlExcelLinks
Worksheets("Staff Rota 2019").Protect "broncko", DrawingObjects:=True,
Contents:=True, Scenarios:=True
end sub
This code must be in a worksheet code instead of a module since you are responding to a button event. The problem is that you select a different worksheet Sheets("Sheet1").Select and there must be some other code that gets run at that point.
Move the code to a module, and reference the specific worksheets directly (do not use the select statement).
for example:
Worksheets("Sheet1").Range("A1").ClearContents
I'm facing an odd situation. I have a button on a sheet which runs many functions, being one of those opening another file:
If Not IsItOpen(ENDERECO2) Then
Workbooks.Open Filename:=ENDERECO1
End If
'ENDERECO2 has the file's name
'ENDERECO1 has the full path of the same file
'IsItOpen is a private function as follows:
'Private Function IsItOpen(Name As Variant) As Boolean
' On Error Resume Next
' IsItOpen = Not (Application.Workbooks(Name) Is Nothing)
'End Function
After opening the other workbook, when it isn't already opened, I bring focus to the first sheet, as I want the second one to be opened on the background. To do that, I use:
'At the very beggining of the code
Dim CEL As Range
Set CEL = Selection
'And at the end of it all
CEL.Select
All the described code works perfectly.
The problem I've been having: as this button runs many things at once, I wanted to add an "Application.Screenupdating = False" at the beggining and "... = True" at the end, so it won't flicker too much when calculating. The thing is that when I added the Screenupdating stuff, it will still open the second workbook as desired, but it won't bring the focus back to the main workbook. Instead, it stops at the recently opened workbook and there it stays.
What could be the interference of the Screenupdating on the CEL.Select command?
Any ideas?
Cheers
Thanks Taelsin. Guess when we don't know exactly why, we improvise lol. This worked fine:
If Not IsItOpen(ENDERECO2) Then
Application.ScreenUpdating = True
Workbooks.Open Filename:=ENDERECO1
Application.ScreenUpdating = False
End If
It is good enough. Cheers!