Stop BeforeCloseEvent when workbook close - vba

I have this code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet
Sheets("MACROS").Visible = True
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "MACROS" Then
ws.Visible = xlVeryHidden
End If
Next ws
Application.CommandBars("Ply").Enabled = True
End Sub
The code displays the MACROS sheet when macros are disabled. The thing is that when macros are enabled, and some work had been done on the workbook, and the book is closed by clicking the "X" (Close Button), it prompts to save but displays the MACROS sheet.
I am looking to have the program remain on active sheet while displaying save prompt.
Would someone be so kind to please help me with modifying the above code? All and any help will be greatly appreciated!

Remove the line Sheets("MACROS").Visible = True.
The code should be:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "MACROS" Then
ws.Visible = xlVeryHidden
End If
Next ws
Application.CommandBars("Ply").Enabled = True
End Sub

Related

Close another workbook upon closing the workbook

I have a code that opens another workbook (source.xlsx) when I open (triggers on Workbook_Open event) a template workbook (template.xlsm).
The code:
Private Sub Workbook_Open()
Application.Screenupdating= False
Set w = workbooks
w.open filename:="link", Updatelinks:=true , readonly:=true
activewindow.visible=false
thisworkbook.activate
application.screenupdating=True
end sub
However, I want the source workbook to just run on background upon opening and close it when I close the template file.
Private sub workbook_aftersave()
Workbook("source.xlsx").Close SaveChanges:=False
End Sub
You want to use the Workbooks collection (Workbooks("source.xlsx")), rather than a Workbook object (Workbook("source.xlsx"), which will throw an error). Also, rather than trying to close it on the Workbook_AfterSave event, you could try using the Workbook_BeforeClose event:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next 'In case the Workbook is already closed
Workbooks("source.xlsx").Close SaveChanges:=False
End Sub
{EDIT} And, because I can, here's a tidier version of your Workbook_Open code too:
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim wsSource As Workbook
Set wsSource = Workbooks.Open(Filename:="SomeDirectory\source.xlsx", UpdateLinks:=True, ReadOnly:=True) 'Change the filename to where your "source.xlsx" is stored
DoEvents 'Wait for it to finish opening
wsSource.Windows(1).Visible = False
ThisWorkbook.Activate
Application.ScreenUpdating = True
End Sub
Try using
Application.Visible = False
Place this in your Workbook_Open code on the workbook you want to hide, and then use True to bring it back to close.

VBA Code to Allow Group / Ungroup in a Protected Workbook

I am using the code below to protect and save the workbook automatically upon closing. However, this code isn't allowing me to use the group / ungroup feature when I re-open the workbook. Can I edit this code to allow the group / ungroup?
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Protect Password:="your password", UserInterfaceOnly:=True, AllowFormattingColumns:=True
ws.EnableOutlining = True
Next ws
ThisWorkbook.Protect "your password", True
ThisWorkbook.Save
End Sub
I tried using the code below to allow the Group/Ungroup on opening, but it doesn't work the way I intended. I had to insert a button into the worksheet. The code does work with the use of a button. I was hoping for one automatic code to solve the group/ungroup problem which doesn't use a button.
Sub Workbook_Open()
For Each ws In Sheets
With ws
.Unprotect Password:="your password"
.Protect Password:="your password", UserInterfaceOnly:=True
.EnableOutlining = True
End With
Next ws
End Sub

VBA Excel: Deleting all charts and graphs in a workbook, except one

I have a macro that generates a lot of worksheets and charts. There's also various subroutines that run so the names and quantity of each worksheet/chart generated is never the same. What is constant is my HOME worksheet which is the UI for the user and I want it to be unaffected.
I found a similar question here about deleting all worksheets except the one you are working with (i.e. HOME). Here's what I have so far.
Sub ZRESET()
Dim ws As Worksheet, wb As Workbook
Set wb = ActiveWorkbook
Sheets("HOME").Select
Application.DisplayAlerts = False
For Each ws In wb.Worksheets
If ws.Name <> "HOME" Then
ws.Delete
End If
If Chart.Name = "" Then
Charts.Delete
End If
Next
Application.DisplayAlerts = True
Range("B5:E5,B9:E9,B13:E13,B14:E14").ClearContents
Range("A1").Select
End Sub
The worksheets delete fine, the hang up I have is the charts. I tried various attempts to remove charts and sometimes they work (i.e placing Charts.Delete outside of a FOR loop and IF statement). But this requires me to actually have a chart in the workbook. Sometime the user can just develop worksheets but no charts.
Any advice to continue my goal of deleting SHEETS and/or CHARTS, while keeping my HOME sheet intact?
Option Explicit
Sub GetRid()
Dim ASheet As Worksheet
Dim AChart As Chart
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'** first scan for and delete all non HOME worksheets ***
For Each ASheet In ActiveWorkbook.Worksheets
If UCase(ASheet.Name) <> "HOME" Then
ASheet.Delete
End If
Next
'** Now scan and delete any ChartSheets ****
For Each AChart In ActiveWorkbook.Charts
AChart.Delete
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Option Explicit
Sub AllSheetsAndcharts()
Dim AChart As ChartObject
Dim ASheet As Worksheet
Application.DisplayAlerts = False
For Each ASheet In ActiveWorkbook.Worksheets
If UCase(ASheet.Name) <> "HOME" Then
For Each AChart In ASheet.ChartObjects
AChart.Delete
Next
ASheet.Delete
End If
Next
Application.DisplayAlerts = False
End Sub

Hide excel worksheet via VBA

I have a workbook that has a number of worksheets each one with a colaborator name on it (Windows login username).
I've tried via VBA to loop through all Worksheets to match the actual Windows Logged On username with the matching Worksheet, and after the match is done, only that Worksheet is kept visible (with all the others being hiden).
I've managed to do this partially but i can only do it untill it finds the matching worksheet. For example, if the matching username is the third worksheet (in a total of ten for example) the code stops there. I want it to run through all worksheets and only then hide the non matching Worksheets.
First i have the following module:
Sub WorksheetFilter()
Dim Username As String
Dim Worksheetname As String
Worksheetname = ActiveWorkbook.ActiveSheet.Name
Username = Environ("Username")
If Worksheetname <> Username Then
ActiveSheet.Visible = False
End If
End Sub
Then, i call the previous module on the Workbook_Open() event:
Option Explicit
Dim WS As Worksheet
Private Sub Workbook_Open()
For Each WS In ActiveWorkbook.Worksheets
WorksheetFilter
Next
End Sub
Any hints on how this can be achieved?
Thanks,
VĂ­tor
Use the code below, and put it in the Workbook module under the Workbook_Open event.
Just loop through all sheets and compare each one with the username.
Option Explicit
Public Sht As Worksheet
Private Sub Workbook_Open()
For Each Sht In ThisWorkbook.Sheets
If Sht.Name = Environ("Username") Then
Sht.Visible = xlSheetVisible
Else
Sht.Visible = xlSheetHidden
' option 2: use very hidden, only able to unhide through code (unable to unhide using right-click)
'Sht.Visible = xlSheetVeryHidden
End If
Next Sht
End Sub
Please see below: chopped your code around a bit. You do not need to defien the worksheets name. This is for the module level, you can call it in the workbook open event as per usual
Option Explicit
Dim ws As Worksheet
Dim Username As String
Sub WorksheetFilter()
Username = Environ("Username")
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> Username Then
ws.Visible = False
Else
ws.Visible = True
End If
Next ws
End Sub
Please let me know how this works for you! :)

VBA excel 2010 working with sheets names and delete blanc sheets

I would like to know why VBA is telling me that the SUB function is missing while trying to write this code. The purpose should be that when the sheet is called NVT the code should skip any operation and go to the next sheet that will be activated (in the next command). In the end of this operation I should delete every blanc sheet(s) where there is no "specific name" or "NVT" filled in.
The formula is working good without this option. I have no problem saving this code and no problem with the formula itselve. Any suggestion is welcom.. I don't believe this threat has been posted yet.
Please let me know if you need additional information. The original code is verry long and would like just a indication how to sove this issue.Thanx in advace for who will answer tis threat.
Sub Printtabs()
' Print
ThisWorkbook.Activate
If ThisWorkbook.Sheets(7) = ("NVT") Then Skip
If ThisWorkbook.Sheets(7) = ("NAME SPECIFIC 1") Then
'process formula
End If
If Thisworkbook.Sheets (8) = ("NVT) Then Skip
If Thisworkbook.Sheets (8) = ("NAME SPECIFIC 2") Then
'process formula
End If
'then I should find the way to delete every "blanc" sheets in this workbook (becouse I skipped before and there will be blanc sheets) and save
End Sub
You don't need to use .Activate. You can directly work with the sheets. Also when deleting sheets and switching off events, always use proper error handling.
Is this what you are trying?
Dim ws As Worksheet
Sub Printtabs()
On Error GoTo Whoa
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "NAME SPECIFIC 1" Then
'~~> Process Formula
ElseIf ws.Name = "NAME SPECIFIC 2" Then
'~~> Process Formula
Else
If ws.Name <> "NTV" And WorksheetFunction.CountA(ws.Cells) = 0 Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
End If
Next ws
LetsContinue:
Application.DisplayAlerts = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
So, I figured out how to delete the blanc sheets I believe.
Only the issue with sheetsnames is remaining.
This part of code I will run at the end of all processed formulas.
Hopely somebody could help me out....
Dim ws As Worksheet
For Each ws In Worksheets
If WorksheetFunction.CountA(ws.Cells) = 0 Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End If
Next ws