changing sheet with macro causes sheet to freeze - vba

My macro for changing sheets doesn't work anymore after I created a few UserForms. Thought the problem was the UserForms were not unloading properly but that doesn't seem to be the case.
When I click the button (which resides in a custom pop up menu) to go to another sheet it works but the sheet acts frozen, I can't scroll or highlight for example.
But if i change sheets by clicking on the tabs then everything is fine. So it would appear that my code to active another sheet is faulty.
My excel workbook has some UserForms, Worksheet_Change and Worksheet_SelectionChange events if that matters.
Is there a better way of doing this. Something that will obviously work and note freeze my sheet after it is activated?
Sheet goto Code:
Sub goto630()
Application.ScreenUpdating = False
Dim sht2 As Worksheet
Set sht2 = ThisWorkbook.Worksheets(2)
Dim sht3 As Worksheet
Set sht3 = ThisWorkbook.Worksheets(3)
sht3.Activate
sht3.Protect _
DrawingObjects:=False, _
Contents:=True, _
Scenarios:=False, _
UserInterFaceOnly:=True, _
AllowFormattingCells:=True
sht2.Visible = True
sht3.Visible = True
On Error GoTo 0
ActiveWindow.Zoom = 90
ActiveWindow.DisplayHeadings = True
ActiveWindow.DisplayHorizontalScrollBar = True
ActiveWindow.DisplayVerticalScrollBar = True
Application.DisplayFormulaBar = True
sht3.DisplayPageBreaks = False
ThisWorkbook.Worksheets(1).Visible = False
ThisWorkbook.Worksheets(4).Visible = False
ThisWorkbook.Worksheets(5).Visible = False
ThisWorkbook.Worksheets(6).Visible = False
ThisWorkbook.Worksheets(7).Visible = False
ThisWorkbook.Worksheets(8).Visible = False
Set sht2 = Nothing
Set sht3 = Nothing
Application.ScreenUpdating = True
End Sub
UserForm Code:
Private Sub UserForm_Click()
Application.OnTime Now + TimeValue("00:00:01"), "Finish"
Unload Me
Call Module2.ScreenRefresh
Exit Sub
End Sub
ScreenRefresh Module is just Application.ScreenUpdating = True read somewhere about this same problem that if the ScreenUpdating is in another module then when called it will fix the freeze issue.
Finish Module is activating the sheet again after the UserForm has been closed (also said to help the freeze issue).
It seems that Excel is waiting for me to click a cell before allowing me to scroll. How can I get around this?
Thanks for any help :)

Related

Retain cutcopy mode after macro

So I have this problem which I can't wrap my head around.
I have a an excel report that executes an important macro on sheet_activate, and as we all know macros cancel CutCopyMode.
Therefore, if I want to copy & paste something from a different file into my report, it never works because as soon as I activate my report it runs the macro and cancels the CutCopyMode from the other file.
Things I have tried:
1) save cutcopymode value and re-activate it after the macro:
Dim tmpCT
tmpCT = Application.CutCopyMode
...
Application.CutCopyMode = tmpCT
the problem: it doesnt work.
2) save the data from the clipboard and re-insert it as plain text object after the macro is done running:
Dim DataClipBoard As String
Dim clipboardData As DataObject
Dim RangeCopied As Range
Set RangeCopied = Selection
DataClipBoard = ClipBoard_GetData
Application.CutCopyMode = False
...
Set clipboardData = New DataObject
With clipboardData
.SetText DataClipBoard
.PutInClipboard
End With
Set clipboardData = Nothing
The problem: it's plain text and doesn't retain formats/links/etc.
I'd appreciate any input you can give me on this issue.
The following macro will return the current range for Cut/Copy, which you can then store in a Range variable and re-Cut/Copy after your other workbook is open.
(Personally, I think that Application.CutCopyRange should be a built-in special variable to do this.)
Function CutCopyRange() As Range
Dim StoredMode As XlCutCopyMode
StoredMode = Application.CutCopyMode
If StoredMode < 1 Then Exit Function 'Null case
If StoredMode = xlCut Then
'Disappointing, since Clipboard lets you Paste a copy of a cut range...
MsgBox "Unfortunately, Worksheet.Paste(Link:=True) only works for Copy-mode.", vbCritical
Exit Sub
End If
Dim ScreenUpdating As Boolean, DisplayAlerts As Boolean, EnableEvents As Boolean
ScreenUpdating = Application.ScreenUpdating
DisplayAlerts = Application.DisplayAlerts
EnableEvents = Application.EnableEvents
Application.ScreenUpdating = False
Application.EnableEvents = False
'This makes us loose our Cut/Copy mode...
With Worksheets.Add
.Paste Link:=True
Set CutCopyRange = Range(Range(Replace(Selection.Cells(1, 1).Formula, "=", "")), _
Range(Replace(Selection.Cells(Selection.Rows.Count, Selection.Columns.Count).Formula, "=", "")))
Application.DisplayAlerts = False
.Delete
End With
'Restore Cut/Copy mode to what it was before the previous block
Select Case StoredMode
Case xlCut
CutCopyRange.Cut
Case xlCopy
CutCopyRange.Copy
End Select
Application.DisplayAlerts = DisplayAlerts
Application.ScreenUpdating = ScreenUpdating
Application.EnableEvents = EnableEvents
End Function

buttons not copying with sheet excel vba

I have some macros that copy my sheet in excel,and delete certain data. Unfortunately the buttons to which the macros are assigned do not copy over when the macros are run.
Sub CandD()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim sh As Shape, strtSh As Worksheet
Set strtSh = ActiveSheet
Sheets("BM Condition").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "BM Condition" & Sheets.Count - 1
Range("E14:E33,I14:I33,M14:M33").ClearContents
For Each sh In ActiveSheet.Shapes
sh.Delete
Next sh
strtSh.Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
This is the macro I am using. I have very limited VBA experience and am not finding google very helpful. Could someone recommend a fix for my buttons not copying over?
EDIT: I forgot to mention that when manually copying the buttons remain. I am not sure why this is.
As FunThomas mentioned, I've tried and tested the following without any errors:
Sub CanD()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim sh As Shape, strtSh As Worksheet
Set strtSh = ActiveSheet
Sheets("BM Condition").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = "BM Condition" & Sheets.Count - 1
Range("E14:E33,I14:I33,M14:M33").ClearContents
strtSh.Select
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Excel VBA worksheet event to toggle between hide / unhide

I am working on a project to minimise the number of sheets that are visible in a an excel workbook at any one given time. I am trying to create a parent sheet (which acts as a toggle button) to show/hide child sheets. For example I have a 6 sheets in a workbook: Inputs, Input 1 and Input 2, Outputs, Output 1 & Output 2. Inputs and Outputs will toggle hide and unhide the others worksheets when activated. I have created 2 worksheet level Sub Functions to try and do this. The first one works great, but the other one only works if the first one has been activated and hidden again. Any advice on a better way to do this would be great. I am not sure why excel doesn't have this function already. I tried with arrays, but that doesn't seem to work. I think you need to unhide each tab individually.
'1. Inputs:
Private Sub Worksheet_Activate()
On Error Resume Next
Sheets("Input 1").Visible = True = Not Sheets("Input 1").Visible = True
Sheets("Input 2").Visible = True = Not Sheets("Input 2").Visible = True
Sheets("Input 1").Activate 'needed to deactivate inputs sheet
End Sub
'2. Outputs
Private Sub Worksheet_Activate()
On Error Resume Next
Sheets("Output 1").Visible = True = Not Sheets("Output 1").Visible = True
Sheets("Output 2").Visible = True = Not Sheets("Output 2").Visible = True
Sheets("Output 1").Activate 'needed to deactivate Outputs sheet
End Sub
Here's a link to a file you can download from onedrive:
https://1drv.ms/x/s!Ah_zTnaUo4DzjhWzQ3OTq9tq1APC
Rather than hard-code what should happen when each sheet is selected, I've used a ListObject (i.e. an Excel Table) on a 'Controls' sheet to store the relationships between 'parent' sheets and their various 'children'. The code simply checks this ListObject to see which children belong to which parent, and then takes action accordingly. This has the added bonus of making it very easy for someone who doesn't understand VBA in the slightest to add or amend those Parent/Child sheet relationships in need.
I've also implemented a 'Developer' mode in which the sheet hiding does NOT happen. Nothing more frustrating than trying to do development on an application that treats you like a mere 'user' :-) You can toggle it between 'User' and 'Developer' mode by using the keyboard shortcut Ctrl + Shift + D (D for Developer).
Here's how that looks in the sample file I just put together. I've added the ListObject shown below into a new sheet called 'Controls', and given the ListObject the name of 'VisibleSheets':
I've also added a named range called DeveloperMode, with a value of TRUE:
Here's the code that toggles the application between 'User' mode and 'Developer' mode, that goes in a standard code module:
Public Sub ToggleDeveloperMode()
Dim ws As Worksheet
If ActiveWorkbook.Names("DeveloperMode").Value = "=TRUE" Then
ActiveWorkbook.Names("DeveloperMode").Value = "=FALSE"
Else
ActiveWorkbook.Names("DeveloperMode").Value = "=TRUE"
For Each ws In ActiveWorkbook.Worksheets
ws.Visible = xlSheetVisible
Next ws
End If
End Sub
Here's the code that actually does all the hiding and unhiding, that also goes in a standard code module:
Sub DisplaySheets()
Dim ws As Worksheet
Dim lo As ListObject
Dim lc As ListColumn
Dim vMatch As Variant
Set lo = Range("VisibleSheets").ListObject
If Not [DeveloperMode] Then
For Each lc In lo.ListColumns
If lc.Name = ActiveSheet.Name Then
For Each ws In ActiveWorkbook.Worksheets
Set vMatch = Nothing 'Reset from last pass
vMatch = Application.Match(ws.Name, lo.HeaderRowRange, 0)
If IsError(vMatch) Then 'It's not one of our main sheets
Set vMatch = Nothing 'Reset from last pass
vMatch = Application.Match(ws.Name, lc.Range, 0)
If IsError(vMatch) Then
ws.Visible = xlSheetVeryHidden
Else
ws.Visible = xlSheetVisible
End If
End If
Next ws
End If
Next lc
End If
End Sub
Here's a snippet of code that goes in the ThisWorkbook module that assigns the Keyboard Shortcut of Ctrl + Shift + D to the ToggleDeveloperMode routine so that you can easily toggle between modes. (Don't tell users what this keyboard shortcut is):
Private Sub Workbook_Open()
Application.OnKey "^+D", "ToggleDeveloperMode"
End Sub
And lastly, here's the code triggers the DisplaySheets routine, that also goes in the ThisWorkbook module:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
DisplaySheets
End Sub
It works a treat. Here's what I see when I select each of the 3 Parent sheets in turn:
...and here's what happens when I use the Ctrl + Shift + D shortcut to put the app into 'Developer' mode, ALL sheets are unhidden, including the one with the controls on it.
I'd suggest giving the parent tabs the same color as I have here, so that it's easier for users to understand that they don't change regardless of the other tabs that selectively appear/disappear.
If there's any chance that users (or you) might want to rename the sheets, use codenames instead of sheetnames. Let me know if you're not sure what I'm talking about.
As per user3598756, this question may need some clarification, however it sounds like you trying to emulate behaviour similar to this:
Action Visible Worksheet
------ -----------------
Open Workbook [Input], [Output]
Activate [Input] [Input], [Output], [Input1], [Input2] ' (shows InputX)
Activate [Input1] [Input], [Output], [Input1], [Input2] ' (no change)
Activate [Output] [Input], [Output], [Output1], [Output2] ' (hides InputX, shows OutputX)
This makes [Input] and [Output] your only gateway worksheets, so the following on [Input] (and the converse for [Output]) would achieve this.
Private Sub Worksheet_Activate()
Sheets("Input 1").Visible = True
Sheets("Input 2").Visible = True
Sheets("Output 1").Visible = False
Sheets("Output 2").Visible = False
End Sub
Notes
Avoid using On Error Resume Next unless you have a specific reason to. It's usually a good thing that your code grinds to a halt if there is something wrong, as opposed to keeping its little secrets to itself and leaving you none the wiser.
The .Visible property is itself a Boolean, so the conditional .Visible = True is equivalent to using just .Visible by itself.
Your .Visible statements are probably not resolving how you intended them to. Only one of your = on each line will be an assignment operator, the others will be equality checks. In the absence of brackets, it will be your first =, and the other = will be step-by-step equality checks working from the right to the left. This is operator precedence at work.
Regarding the last point, say sheet Input 1 is visible, your first line will resolve as:
Sheets("Input 1").Visible = True = Not Sheets("Input 1").Visible = True
Sheets("Input 1").Visible = True = Not <True> = True
Sheets("Input 1").Visible = True = Not <True>
Sheets("Input 1").Visible = True = <False>
Sheets("Input 1").Visible = <False>
Where what I believe was intended is:
Sheets("Input 1").Visible = Not Sheets("Input 1").Visible ' i.e. toggle my visibility
These things can be hard to pick up with booleans, because even if your logic is wrong, the result can be right 'half' of the time.
I have managed to make this work. The issue was had something to do with trying to use the "Outputs" Private Sub Worksheet_Activate() function when the "Input 1" sheet was activated and hidden. I have added another tab called "Main" to replace this, so "Main" will always be the active tab after the function has been activated. This resolves the issue although it would be better if the focus didn't jump around the workbook while navigating what in each "folder". Here is the updated code...
'Inputs "Parent folder" sheet
Private Sub Worksheet_Activate()
On Error Resume Next
Sheets("Input 1").Visible = True = Not Sheets("Input 1").Visible = True
Sheets("Input 2").Visible = True = Not Sheets("Input 2").Visible = True
**Sheets("Main").Activate** 'needed to deactivate Inputs sheet
End Sub
'Outputs "Parent folder" sheet
Private Sub Worksheet_Activate()
On Error Resume Next
Sheets("Output 1").Visible = True = Not Sheets("Output 1").Visible = True
Sheets("Output 2").Visible = True = Not Sheets("Output 2").Visible = True
**Sheets("Main").Activate** 'needed to deactivate Outputs sheet
End Sub
I think this is a great way to simplify workbooks with may tabs. It could defiantly be improved so look forward to hearing any suggestions.
Here is a link to my working file
https://1drv.ms/x/s!AvtNNMCst1bIgxjCBCemZlCerHMo

Excle VBA - "Screenupdating=True" malfunction: Screen doesn't refresh (e.g. to change worksheet view)

I'm having issues with a workbook not changing view to a newly unhidden/activated worksheet in-between toggling screen updating from off to on and back off again - it's not actually refreshing the screen. (code below)
I have module that calls forms and subs from a main sub to carry out a number of tasks - within each of the subs (except the main) I turn off screen updating in the beginning and turn it on at the end (example below). The workbook has a number of worksheets (mostly hidden) that are used for processing or as the final visible view - when opened, only one sheet is visible (used to launch the main sub).
While running, one of the subs unhides and activates the final worksheet, then deletes the starting worksheet - and toggles screen updating back on ("True"), and exits back to the main sub (which calls another sub again).
But it doesn't change view, the view stays on the deleted sheet while the subs all finish. (I can "trick" it into changing view to the newly active worksheet by inserting a "MsgBox" - but don't want to do that.)
This has been a hard one for me to search out answers (because looking up "Screenupdating" and anything else brings up a myriad of answers regarding "how to stop the screen from updating").
Sub createADS()
Dim oneForm As Object
Set MainWrkBk = ActiveWorkbook
cancel = False 'initialise
Call ADSheaderFormShow
Set MainWrkBk = ActiveWorkbook 're-Set MainWrkBk after doing "SaveAs" in previous form
Call ADSformGen
MainWrkBk.Worksheets("ADSform").Activate 'Doesn't change view
'MsgBox "Enter antenna information from RFDS"
'^^^ Tricks it into refreshing worksheet when active
Call ADSinputFormShow
Call ADSsetAntennas
Call ADSpullData
GoTo ExitHandler
ExitHandler:
For Each oneForm In UserForms
Unload oneForm
ThisWorkbook.Save
Next oneForm
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Private Sub ADSformGen()
Application.ScreenUpdating = False 'Returned to True after running sub
MainWrkBk.Worksheets("HidDbSh").Visible = True
MainWrkBk.Worksheets("HidDbSh").Cells(1, 1).Value = "Site Info"
MainWrkBk.Worksheets("HidSiteTemp").Range("a1").CurrentRegion.Copy _
Destination:=MainWrkBk.Worksheets("HidDbSh").Cells(2, 1)
Columns.AutoFit
Application.Calculation = xlCalculationAutomatic 'to reset all formula calcs before deleting source
MainWrkBk.Worksheets("HidDbSh").Visible = False
Application.DisplayAlerts = False
MainWrkBk.Worksheets("HidSiteTemp").Delete
Application.DisplayAlerts = True
MainWrkBk.Worksheets("HidADSform").Visible = True
MainWrkBk.Worksheets("HidADSform").Name = "ADSform"
With MainWrkBk.Worksheets("ADSform").UsedRange
.Copy
.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
Application.DisplayAlerts = False
MainWrkBk.Worksheets("BlankADSForm").Delete
Application.DisplayAlerts = True
MainWrkBk.Worksheets("ADSform").Activate
MainWrkBk.Worksheets("ADSform").Range("B2").Select
Application.ScreenUpdating = True
End Sub
If you want to ensure that the screen updates when you active the sheet, turn screen updating on before you active it. Otherwise, you risk the redraw event that the Activate call will generate getting swallowed:
'...
Application.ScreenUpdating = True
MainWrkBk.Worksheets("ADSform").Activate
MainWrkBk.Worksheets("ADSform").Range("B2").Select
End Sub

VBA Unwanted loop through worksheets

I have used this site quite a bit but this is the first question i have posted, hopefully I can give enough detail. I cannot find any relevant answers because no matter what i search, I get various answers relating to looping code.
Some background:
I have designed an excel document to track some items in my workplace (hereafter referred to as Master Document). As the previous tracker allowed users to edit anything at any time, I have used forms to ensure all information is entered correctly and stored securely. For each item in the Master Document there is a separate excel workbook (hereafter referred to as Item Document).
There are a number of sheets in the Master Document which run code everytime they are activated (because they need to update).
As there is some VBA code in every Item Document which is crucial in syncing data with the Master Document, I have added a Warning worksheet which is shown when the Item Document is opened without macros. This involved using the workbook open, before save and after save events to ensure only the Warning is shown without macros. Here is the code for each event (placed in ThisWorkbook Module obviously)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Auto_Open
'This is for sync (Master Document checks for text file to see if any changes have been made to Item Document)
If booChange = True Then
Dim oFile As Object
Set oFile = fso.CreateTextFile(strTextFile)
SetAttr strTextFile, vbHidden
booChange = False
End If
'Turn off Screen Updating
Application.ScreenUpdating = False
'Show warning sheet
Sheets("Warning").Visible = xlSheetVisible
'Hide all sheets but Warning sheet
For Each sh In ThisWorkbook.Worksheets
If Not sh.Name = "Warning" Then sh.Visible = xlVeryHidden
Next sh
End Sub
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
'Show all sheets
For Each sh In ThisWorkbook.Worksheets
sh.Visible = xlSheetVisible
Next sh
'Hide the warning sheet
Sheets("Warning").Visible = xlVeryHidden
'Return focus to the main page
ThisWorkbook.Worksheets(1).Activate
'Turn on Screen Updating
Application.ScreenUpdating = True
ThisWorkbook.Saved = True
End Sub
Private Sub Workbook_Open()
'Turn off Screen Updating
Application.ScreenUpdating = False
'Show all sheets
For Each sh In ThisWorkbook.Worksheets
sh.Visible = xlSheetVisible
Next sh
'Hide the warning sheet
Sheets("Warning").Visible = xlVeryHidden
'Return focus to the main page
ThisWorkbook.Worksheets(1).Activate
'Turn on Screen Updating
Application.ScreenUpdating = True
ThisWorkbook.Saved = True
End Sub
And just for completeness, here is all code in Module1 of Item Document
'Declarations
'Strings
Public strSourceFolder As String
Public strTextFile As String
'Other
Public fso As FileSystemObject
Public booChange As Boolean
Public wsFlow As Worksheet
'Constants
Public Const strURNSheetName = "Part 1 Plant Flow Out Summ"
Sub Auto_Open()
Set fso = CreateObject("Scripting.FileSystemObject")
Set wsFlow = ThisWorkbook.Worksheets(strURNSheetName)
strSourceFolder = fso.Getfile(ThisWorkbook.FullName).ParentFolder.Path
strTextFile = fso.BuildPath(strSourceFolder, ThisWorkbook.Worksheets(strURNSheetName).Range("W2").Value & ".txt")
End Sub
When an item is created in the Master Document using the 'frmNewEntry' form the info is checked and entered into the Master Document then a template Item Document is opened and saved with a new unique filename. It is then unprotected, updated with the new information, protected, saved and closed. The Master Document is then saved. Code follows (edited to omit lengthy formatting and data entry):
Form Code:
Private Sub btnSave_Click()
'Values on form are verified
'Master Document sheet is unprotected, formatted and data entry occurs
'Clear Userform and close
For Each C In frmNewEntry.Controls
If TypeOf C Is MSForms.ComboBox Then
C.ListIndex = -1
ElseIf TypeOf C Is MSForms.TextBox Then
C.Text = ""
ElseIf TypeOf C Is MSForms.CheckBox Then
C.Value = False
End If
Next
frmNewEntry.Hide
'Create filepaths
Create_Filepath
'Some hyperlinks are added and the Master Document worksheet is protected again
'Create Flowout Summary
Create_Flowout_Summary
'Update Flowout Summary
Update_Flowout_Summary
'Turn on screen updating
Application.ScreenUpdating = True
'Update Activity Log
Update_Log ("New: " & strNewURN)
Debug.Print "Before Save Master"
'Save tracker
ThisWorkbook.Save
Debug.Print "After Save Master"
End Sub
Module1 Code:
Public Sub Create_Flowout_Summary()
'Create a new flowout summary from the template
'Turn off screen updating
Application.ScreenUpdating = False
'Check if workbook is already open
If Not Is_Book_Open(strTemplate) Then
Application.Workbooks.Open (strTemplatePath)
End If
Debug.Print "Before SaveAs Create"
'Save as new flowout summary
Application.Workbooks(strTemplate).SaveAs fileName:=strFilePath
Debug.Print "After SaveAs Create"
'Close Document Information Panel
ActiveWorkbook.Application.DisplayDocumentInformationPanel = False 'Doesn't seem to work
'Turn on screen updating
Application.ScreenUpdating = True
End Sub
Public Sub Update_Flowout_Summary()
'Update the flowout summary for current call
Dim wsURN As Worksheet
Set wsURN = Workbooks(strFileName).Worksheets(strWsURNName)
'Unprotect Flowout Summary worksheet
wsURN.Unprotect "Flowout Summary"
'Write values to flowout summary
'Protect Flowout Summary worksheet
wsURN.Protect "Flowout Summary", False, True, True, True, True
Debug.Print "Before Save Update"
'Save flowout summary
Application.Workbooks(strFileName).Save
Debug.Print "After Save Update"
'Close Document Information Panel
ActiveWorkbook.Application.DisplayDocumentInformationPanel = False
'Turn on screen updating
Application.ScreenUpdating = True
End Sub
Problem detail:
When I create a new entry it is taking a very long time, I accidentally discovered that the Master Document is running the code in every sheet activate event (mentioned above) (I had a diagnostic msgbox in one of the sheets which mysteriously appeared when i created a new entry)
I have therefore drawn the conclusion that the code is somehow activating every worksheet but have no idea why....
Any help will be much appreciated, and if i have missed anything out that may help in diagnosing just let me know.
EDIT: The other strange phenomenon is that this does not happen when I try to step through the code to find exactly where the activate events are being triggered.
EDIT: Code in the worksheet activate event
Private Sub Worksheet_Activate()
'Turn off Screen Updating
Application.ScreenUpdating = False
'Simply writes data to the sheet (excluded because it is lengthy)
'Turn on Screen Updating
Application.ScreenUpdating = True
wsMyCalls.Protect Password:=strPassword
Debug.Print "wsMyCalls"
MsgBox "This sheet uses your username to display any calls you own." & vbNewLine & _
"It relies on the correct CDSID being entered for owner." & vbNewLine & vbNewLine & _
"Regards" & vbNewLine & _
"Your friendly spreadsheet administrator", vbOKOnly, "Information"
End Sub
EDIT: I added some Debug.Prints to the code (above) and this is what i got.
Before SaveAs Create
After SaveAs Create
Before Save Update
After Save Update
Before Save Master
After Save Master
wsMyCalls
This shows that the code is executing between Debug.Print "After Save Master" and an End Sub. There is no code in there???
Thanks
I believe we aren't seeing your whole code on here. It is difficult to diagnose considering we don't have the workbook to debug ourselves. However I have a similar 'welcome' page that is displayed every time one of my workbooks opens to ask the user to activate macroes. I DO put EnableEvents to false and put my sheet in a certain state before saving, and placing it back after saving.
I will show you exactly how I do it because I have a feeling your problem is related to not disabling EnableEvents are the right timings. I am unsure how to time it based on how your workbook functions because of the mentioned incomplete code.
The sheet is called f_macros. Here is it's worksheet activate event that prevents further navigation:
Private Sub Worksheet_Activate()
ActiveWindow.DisplayHeadings = False
ActiveWindow.DisplayWorkbookTabs = False
End Sub
In my Workbook_BeforeSave:
I record the current state of DisplayHeadings and such at first:
Dim Displaytabs As Boolean
Dim DisplayHeadings As Boolean
Dim menu As CommandBar
Dim ligne As CommandBarControl
Displaytabs = ActiveWindow.DisplayWorkbookTabs
DisplayHeadings = ActiveWindow.DisplayHeadings
I then reset my custom right click, turn off EnableEvents and screen updating. I set DisplayWorkbookTabs to false for good measure.
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.CommandBars("Cell").reset
ActiveWindow.DisplayWorkbookTabs = False
Then I run Cacherdata (HideData, sub in another module that is annexed underneath) I save, and i run the sub macro_activees to put the workbook back in working order for the user. I turn EnableEvents back on, and put the headings back to how they were:
m_protection.Cacherdata
ThisWorkbook.Save
m_protection.macro_activees
Application.ScreenUpdating = True
Application.enableevents = True
ActiveWindow.DisplayWorkbookTabs = Displaytabs
ActiveWindow.DisplayHeadings = DisplayHeadings
I cancel the ordinary Save (important!) and indicate the workbook is saved so they can exit normally without being prompted to save.
Cancel = True
ThisWorkbook.Saved = True
In the BeforeClose, it checks whether or not the workbook state is Saved. if yes, it quits. If not, it does a similar procedure:
If Not (ThisWorkbook.Saved) Then
rep = MsgBox(Prompt:="Save changes before exiting?", _
Title:="---", _
Buttons:=vbYesNoCancel)
Select Case rep
Case vbYes
Application.ScreenUpdating = False
Application.enableevents = False
ActiveWindow.DisplayHeadings = True
m_protection.Cacherdata
ThisWorkbook.Save
Case vbCancel
Cancel = True
Exit Sub
End Select
End If
The workbook open event checks whether it is read-only mode, but that's all. I don't have a Workbook AfterSave.
Annex
CacherData makes every sheet VeryHidden so the user doesn't f*** up the data without activating macros. It records the current active sheet so the user goes back to where they were, unprotects the workbook, hides sheets, protects it back and that's all:
Sub Cacherdata()
Dim ws As Worksheet
f_param.Range("page_active") = ActiveSheet.Name
f_macros.Activate
ThisWorkbook.Unprotect "-----"
For Each ws In ThisWorkbook.Worksheets
If ws.CodeName <> "f_macros" Then ws.visible = xlSheetVeryHidden
Next
ThisWorkbook.Protect "-----"
Exit Sub
End Sub
macros_activees does the opposite:
Sub macro_activees()
Dim ws As Worksheet
ThisWorkbook.Unprotect "-----"
For Each ws In ThisWorkbook.Worksheets
ws.visible = xlSheetVisible
Next
ThisWorkbook.Sheets(f_param.Range("page_active").Value).Activate
ThisWorkbook.Unprotect "-----"
'it unportects twice because of the activate event of the worksheet, don't mind that
Exit Sub
End Sub
Error handling was removed because it was useless to show, but everything else should be there.
EDIT: If this doesn't help you at all, maybe your problem is because the workbooks you create have code in them 9from what i gather) that can affect how long it takes to run your code? If they have an Open procedure themselves, could that be it?