How do I improve my short VBA code as below? - vba

I tried to protect cells on my workbook from being edited. I wrote this code,
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End Sub
But after some tests, I caught an exception. If I cut a cell and paste to another cell, it's ALLOWED! I'm not sure if there are other exceptions like this that I haven't figured out. My question is how do I protect cells being edited but meanwhile able to be copied?

Use the interface only option, this allows the sheet to be locked - but only for user interactions. Any code can interact with the sheet without being blocked:
Private Sub Workbook_Open()
For Each ws In ThisWorkbook.Sheets
ws.Protect UserInterfaceOnly:=True
Next
End Sub

without protecting the sheets the only solution I can think of is:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Application.CutCopyMode = 2 Then Application.CutCopyMode = 0
End Sub
Should be self-explaining ;)
or runn all sheets like:
Sub protectAllSheets()
Dim x As Variant
For Each x In ThisWorkbook.Sheets
x.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Next
End Sub

Related

Making VBA apply to renamed tabs & all tabs in a workbook

I don't know very much at all about VBA, but I found the below code on a website and am using it in a workbook.
Private Sub Workbook_Open()
With Worksheets("WFD")
.EnableOutlining = True
.Protect Password:="XXXX", _
Contents:=True, UserInterfaceOnly:=True
End With
End Sub
How should I amend this so that if the Sheet name is changed from "WFD" to something else, the code still works? Also I would like it to apply to all sheets in the workbook.
Thanks very much
If you want this code for each worksheet use code below:
Private Sub Workbook_Open()
Dim ws As Worksheet
For Each ws In Worksheets
With ws
.EnableOutlining = True
.Protect Password:="XXXX", _
Contents:=True, UserInterfaceOnly:=True
End With
Next
End Sub
You should use the Sheet Object Codename.
This is found in the VB Editor beside the sheet objects in the VB project.
By default they are Sheet1, Sheet2 etc. You can easily change them by clicking and typing a new name etc.
You could of course leave them as default codeName if you like...
This is NOT the same as the worksheet name, which is changed by users on the Sheet tabs in Excel interface.
Private Sub Workbook_Open()
With WFD 'where WFD is the CODENAME of the Sheet Object!
.EnableOutlining = True
.Protect Password:="XXXX", _
Contents:=True, UserInterfaceOnly:=True
End With
End Sub
You could write Worksheets(1) or Worksheets(5), depending on the number of the Worksheet. However, if you start adding and deleting Worksheets, it whould not work (e.g., it would be working on some other worksheet). To see the associated number to the worksheet, run this and check the immediate window:
Option Explicit
Public Sub TestMe()
Dim ws As Worksheet
Dim cnt As Long
For cnt = 1 To ThisWorkbook.Worksheets.Count
Debug.Print cnt; "-> "; Worksheets(cnt).name
Next cnt
End Sub
However, if you have only one Worksheet, Worksheets(1) would always work.

How can I run an excel enabled event macro across all open sessions in excel?

VBA newbie here.
I have an excel spreadsheet that is locked for formatting. However, if you paste into the spreadsheet, the format copied is then pasted into the locked worksheet. I'm using the code below to create an event in excel to undo and paste special values.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Application.CutCopyMode = xlCopy Then
Application.EnableEvents = False
Application.Undo
Target.PasteSpecial Paste:=xlPasteValues
Application.EnableEvents = True
End If
End Sub
This works perfectly, however, this only works if I am copying and pasting within the same excel session. How can I get this to work across all excel instances?
Thanks!
Dan
Paste this into the Thisworkbook module of the same file (assuming that moduleis currently empty!):
Option Explicit
Private WithEvents App As Application
Private Sub App_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Application.CutCopyMode = xlCopy Then
Application.EnableEvents = False
Application.Undo
Target.PasteSpecial Paste:=xlPasteValues
Application.EnableEvents = True
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Set App = Nothing
End Sub
Private Sub Workbook_Open()
Set App = Application
End Sub

How to apply workbook_open to multiple sheets

I have a excel workbook that a number of users interact with daily and on multiple montiors with different resolutions, screen zooms etc.. I need all worksheets to adjust to the ranges on each sheet I want the user to see each time.
Below works for 1 worksheet, but how would I get it to apply to all worksheets (Sheet1,Sheet2,etc.)
Private Sub Workbook_Open()
With Sheets("Sheet1")
Columns("A:P").Select
ActiveWindow.Zoom = True
Range("A1").Select
End With
End Sub
You can use the Worksheet_Activate event, and place code such as
Private Sub Worksheet_Activate()
Columns("A:P").Select
ActiveWindow.Zoom = True
Range("A1").Select
End Sub
on each sheet, editing the range as required.
That code will execute every time the sheet is activated, which may or may not be what you would like, so you may need to use something a bit more complicated and use:
Private AlreadyRun As Boolean
Private Sub Worksheet_Activate()
If Not AlreadyRun Then
Columns("A:P").Select
ActiveWindow.Zoom = True
Range("A1").Select
AlreadyRun = True
End If
End Sub
which will only do something the first time the sheet is activated (as the AlreadyRun variable will originally be False, but will be changed to True once it is run once), or
Private AlreadyRun As Boolean
Private Sub Worksheet_Activate()
Dim CurRng as Range
Set CurRng = Selection
Columns("A:P").Select
ActiveWindow.Zoom = True
CurRng.Select
If Not AlreadyRun Then
Range("A1").Select
AlreadyRun = True
End If
End Sub
which will resize the sheet every time it is activated, but only move the selected cell to A1 the first time.
To avoid the issue caused by the sheet which is current when the Workbook is saved not going through the Worksheet_Activate event when the workbook is reopened, you can include a Workbook_Open event that says
Private Sub Workbook_Open()
Application.Screenupdating = False
Dim ws As Worksheet
Set ws = Activesheet
'For the next two lines, just pick any two of your worksheets
'All it is trying to do is to ensure whichever sheet was active at open
'is deactivated before being activated again in the "ws.Activate" command
Worksheets("Sheet1").Activate
Worksheets("Sheet2").Activate
ws.Activate
Application.Screenupdating = True
End Sub
(Disabling Screenupdating while the event is run will avoid the users seeing any "flickering" of worksheets.)

VBA Trying to make WorkSheet_Change work on multiple sheets but not all

I need to make a Worksheet_Change that checks for the change of values in 2 different cells in 2 different sheets. However I have more than 2 sheets and don't want to use a Workbook_Change so those other sheets are not affected.
My Code works but only checks for the cells in one worksheet but not for the other worksheet. I need to check in both worksheets.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M9")) Is Nothing Then
Application.EnableEvents = False
Application.ScreenUpdating = False
Call Macro5
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
If Not Intersect(Target, Range("I88")) Is Nothing Then
Application.EnableEvents = False
Application.ScreenUpdating = False
Call Macro6
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub
Thanks.
In the Workbook's code module you can access events triggered on any Worksheet.
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
If (Not Intersect(Target, Range("M9")) Is Nothing) Then
Call Macro5
ElseIf (Not Intersect(Target, Range("M9")) Is Nothing) Then
Call Macro6
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
If you need to know what worksheet the event fired on you can use the ByVal Sh As Object parameter.
If Sh.Name = "Sheet1" then
If you want to access the Sh object's properties using intellisense, cast Sh back from a Object back into a WorkSheet Object
Dim ws as WorkSheet
Set ws = Sh
The Private command restricts your subroutine to the current worksheet, so you're correct in using that command to keep the subroutine from altering all of your sheets.
Like newguy said, the simplest fix is to place the code in each of the worksheet modules you want it to alter, each using the Private command.

Force the user to select only one specific cell

I cannot lock my sheet because I need to access some cells to run macros.
I want a macro that selects cell (F1) whenever the user try to select any other cell.
I need a macro like this one, I guess:
Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
Put this code in the worksheet module:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call Cells(1, 6).Select
End Sub
Like other guys wrote, is better to unprotect the sheet, play your macro and protect the sheet but, if you think that disable all cells, minus the cell that you identify, is the best way, you can use this code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("F10")) Is Nothing Then 'use your free cell
do
Else
Application.Undo
MsgBox "you can modify only the cell(F10)" 'Just to inform what is the cell editable
Range("F10").Select
End If
Application.EnableEvents = True
End Sub
Here are 2 options:
.
1. Without protecting the sheet - in each sheet module to customize "unlocked" cell (Ex. "C3")
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
With Target
If .Column <> 3 Or .Row <> 3 Or .CountLarge > 1 Then Application.Undo
End With
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
With Target
If .Column <> 3 Or .Row <> 3 Or .CountLarge > 1 Then Cells(3, 3).Select
End With
Application.EnableEvents = True
End Sub
.
2. Protecting the sheet - in ThisWorkbook module
Private Sub Workbook_Open()
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
protectWS ws
Next
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
protectWS Sh
End Sub
Public Function protectWS(Optional ByRef ws As Worksheet = Nothing) As Boolean
If ws Is Nothing Then Set ws = Application.ActiveSheet
If Not isWSProtected(ws) Then
ws.Protect Password:=vbNullString, _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
UserInterfaceOnly:=True, _
AllowFormattingCells:=False, _
AllowFormattingColumns:=False, _
AllowFormattingRows:=False, _
AllowInsertingColumns:=False, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=False, _
AllowDeletingColumns:=False, _
AllowDeletingRows:=False, _
AllowSorting:=False, _
AllowFiltering:=False, _
AllowUsingPivotTables:=False
End If
End Function
Private Function isWSProtected(Optional ByRef ws As Worksheet = Nothing) As Boolean
isWSProtected = ws.ProtectContents Or _
ws.ProtectDrawingObjects Or _
ws.ProtectScenarios
End Function
Option 1 forces users to cell C3
can be moved to ThisWorkbook module, with parameters for row and column
Option 2 is using an empty password, and allows VBA execution (UserInterfaceOnly)