Excel VBA: protecting my worksheets slows down my vba code significantly - vba

I am very new to VBA and have basically taught myself while building my current Excel 'contract'. My goal is have a list of contract options which are shown or hidden depending on their representative check boxes. There are 12 total options with ranges that I show/remove across 4 worksheets.
In terms of organization, I have utilized modules based on each action. I also named all my ranges
Prior to me protecting my worksheet, when I select a checkbox, all 4 ranges across all 4 worksheets immediately show. When I unselect, they immediately clear their contents and hide. Yay!
Once I protect my worksheet, however, things either slow down to a crawl or I get an error. In my ProtectWorksheet module below, the commented out lines work, but from reading other stack overflow articles it seens better to use the code I have. Unprotected, it works great. Protected I get the "Error 1004': Unable to set the Hidden property of the Range class". If I instead use my commented out code while protected, it works but is super slow.
Technically I can get everything to work...but from a user interface stance it's terrible.
Below is the 1st contract option I have been testing. Please and thank you for any and all help!
under the Excel Objects - sheet2(Data Input)
Private Sub chkDomesticHotWater_Click()
ProtectOFF
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
If chkDomesticHotWater = True Then
AddDomesticHotWater
Else
'Remove the lines, clear the data, and move the mouse to the top
RemoveDomesticHotWater
ClearDomesticHotWater
Range("A1").Select
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
ProtectON
End Sub
under the Module: Checkboxes
Sub AddDomesticHotWater()
[DataInput_DomesticHotWater].EntireRow.Hidden = False
[Contract_DomesticHotWater].EntireRow.Hidden = False
[Invoice_DomesticHotWater].EntireRow.Hidden = False
[ExpectedCost_DomesticHotWater].EntireRow.Hidden = False
End Sub
Sub RemoveDomesticHotWater()
[DataInput_DomesticHotWater].EntireRow.Hidden = True
[Contract_DomesticHotWater].EntireRow.Hidden = True
[Invoice_DomesticHotWater].EntireRow.Hidden = True
[ExpectedCost_DomesticHotWater].EntireRow.Hidden = True
End Sub
Under the Module ClearData
Sub ClearDomesticHotWater()
Range("DataInput_DomesticHotWater").Select
For Each cell In Selection
If cell.Interior.Color = RGB(226, 239, 218) Then
cell.ClearContents
End If
Next
Range("DomesticHotWaterStart").Select
End Sub
under the Module ProtectWorksheet
Sub ProtectON()
Dim ws As Worksheet
Dim pwd As String
pwd = "123" ' Put your password here
For Each ws In Worksheets
ws.Protect Password:=pwd, UserInterfaceOnly:=True
Next ws
'Worksheets("Data Input").Protect Password:="123"
'Worksheets("Contract").Protect Password:="123"
'Worksheets("Invoice").Protect Password:="123"
'Worksheets("Expected Cost").Protect Password:="123"
End Sub
Sub ProtectOFF()
Dim ws As Worksheet
Dim pwd As String
pwd = "123" ' Put your password here
For Each ws In Worksheets
ws.Unprotect Password:=pwd
Next ws
'Worksheets("Data Input").Unprotect Password:="123"
'Worksheets("Contract").Unprotect Password:="123"
'Worksheets("Invoice").Unprotect Password:="123"
'Worksheets("Expected Cost").Unprotect Password:="123"
End Sub
EDIT
I was able to speed it up just a tiny bit by updating my Protect On/Off code below, but it's still a 3-5 second delay when I click on my check boxes:
Sub ProtectON()
Dim ws As Worksheet
Set WSArray = Sheets(Array("Data Input", "Contract", "Invoice", "Expected Cost"))
For Each ws In WSArray
ws.Protect Password:="123"
Next
End Sub
Sub ProtectOFF()
Dim ws As Worksheet
Set WSArray = Sheets(Array("Data Input", "Contract", "Invoice", "Expected Cost"))
For Each ws In WSArray
ws.Unprotect Password:="123"
Next
End Sub
EDIT - SOLUTION?
So I don't think this is best practice, nor have I really 'solved' my delay, but I found a workaround. I eliminated the delay when clicking my check boxes by turning on protection yet allowing row formatting. Technically my sheet is no longer 100% protected from user tinkering, but I think that risk is worth removing such an annoying wait time after clicking.
Sub ProtectON()
Dim ws As Worksheet
Set WSArray = Sheets(Array("Data Input", "Contract", "Invoice", "Expected Cost"))
For Each ws In WSArray
ws.Protect Password:="123", AllowFormattingRows:=True
Next
End Sub

It should not be that slow, although I really have no clue how fast is your PC and how big is the data. However, here is something you can make better:
Sub ClearDomesticHotWater()
For Each cell In [DataInput_DomesticHotWater]
If cell.Interior.Color = RGB(226, 239, 218) Then
cell.ClearContents
End If
Next
End Sub
and remove all selects, they are slowing you down. Go around them like this:
How to avoid using Select in Excel VBA macros

Related

How can I recode this so it can loop through specific worksheets in a workbook

I have a macro that I need to loop through specific worksheets, but I built the code through many examples I found online. So I am not quite sure where or how to set the loop and I'm also certain I would have to change the way the whole code is set up. I really have no coding knowledge at all. Meep.
Sub datatransfer()
Application.ScreenUpdating = False
Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Set copySheet = Worksheets(ActiveSheet.Name)
Set pasteSheet = Worksheets("CMICIMPORT")
copySheet.Range("A100:AA124").Copy
pasteSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Data was copied over to the CMICIMPORT tab successfully", vbInformation, ActiveSheet.Name
Range("M4").Select
With Selection.Font
.Color = -11489280
.TintAndShade = 0
End With
End Sub
I have to run the code above on each sheet that I am currently on as opposed to being able to run the Macro and it runs on all of my payroll tabs. Also my tabs are named payroll (1), payroll (2) and so forth through payroll (200) if this makes it easier to help me.
This is a quick and dirty solution, but still would work.
Start with declaring the sheets which should be looped in an Array() called specificWorksheets. If they are indeed 200, then it is a better idea to create some kind of a loop or to read them from a settings worksheets. Anyway, this is the working part:
Sub TestMe()
Dim specificWorksheets As Variant
specificWorksheets = Array("payroll (3)", "payroll (1)", "payroll (2)")
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If valueInArray(wks.Name, specificWorksheets) Then
wks.Activate
'Do your stuff, writing before...
End If
Next
End Sub
Public Function valueInArray(myValue As Variant, myArray As Variant) As Boolean
Dim cnt As Long
For cnt = LBound(myArray) To UBound(myArray)
If LCase(CStr(myValue)) = LCase(CStr(myArray(cnt))) Then
valueInArray = True
Exit Function
End If
Next cnt
End Function
At the place of the comment 'Do your stuff , copy and paste your code.
Why is this Quick and dirty? Mainly because of the using Activate and thus referring to the active worksheet. Once you realize how the for-each loop works, it is a better idea to read this - How to avoid using Select in Excel VBA - and to rewrite your code. There is a reason, why this is the second most popular topic in [vba] in StackOverflow.
Sub DataTransfer()
Dim sht As Worksheet
Application.ScreenUpdating = False
For each sht in ThisWorkbook.Worksheets
If Left(sht.Name, 7) = "payroll" Then DoIt sht
Next
Application.ScreenUpdating = True
End Sub
Sub DoIt(copySheet As Worksheet)
copySheet.Range("A100:AA124").Copy
Worksheets("CMICIMPORT").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
MsgBox "Data was copied over to the CMICIMPORT tab successfully", vbInformation, copySheet.Name
With copySheet.Range("M4").Font
.Color = -11489280
.TintAndShade = 0
End With
End Sub

Error Handling for solution on sorting on protected Worksheets

On a protected user form (table with data) I have found a possibility to allow sorting protected cells by unprotecting the header row when selected (if...then) and protecting the sheet whenever another cell(s) is selected (else). So now, when clicking the header row and clicking the filter symbol, users can sort, because in this moment the file is unprotected.
Now, there is one problem remaining: when users select data in the databodyrange (or any other cell that is not in header row (here: row 11)) and then directly click on the filter symbol in the header row for sorting, they have activated cells that cause the sheet to protect (Else) and to unprotect (If...then) at the same time.
So the code itsself works fine. What I struggle with is writing an error handling, that for example on error selects a cell in the header row and continues to run the macro in all funcionality + doesn't disturb the user.
What is an easy Error Handling for the following code?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Ws As Worksheet
Set Ws = Target.Worksheet
If (Target.Row = 11) Then 'Row 11 is the tables header's row
With Ws
.Unprotect ""
End With
Else
With Ws
.EnableAutoFilter = True
.EnableOutlining = True
.Protect "", contents:=True, UserInterfaceonly:=True, AllowFormattingRows:=True, AllowFiltering:=True, AllowSorting:=True
End With
End If
End Sub
Thanks - and really just an error handling is looked for. No other workaround!
I solved my own issue using On Error Resume Next. It is not super elegant, but this way users are able to "sort on a protected sheet with locked cells".
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Ws As Worksheet
Set Ws = Target.Worksheet
On Error Resume Next
If Err.Number <> 0 Then
Application.Undo
MsgBox "Please select a cell in the header row, before sorting or filtering."
End If
If (Target.Row = 11) Then
With Ws
.Unprotect ""
End With
Else
With Ws
.EnableAutoFilter = True
.EnableOutlining = True
.Protect "", contents:=True, UserInterfaceonly:=True, AllowFormattingRows:=True, AllowFiltering:=True, AllowSorting:=True
End With
End If
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.)

how to make visual basic work on protected worksheets (no password on protection)

I have a work book with several worksheets that I would like to protect. I am not using a password on the protection. I have some visual basic code associated with this sheet to expand the row width on merged cells. The code will not work when the sheets are protected.
I did find some guidance on adding unprotect code to my code, but can't figure out where to put it and how to address the fact that there is no passord. Further guidance woudl be greatly appreciated!
Here is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range
With Target
If .MergeCells And .WrapText Then
Set c = Target.Cells(1, 1)
cWdth = c.ColumnWidth
Set ma = c.MergeArea
For Each cc In ma.Cells
MrgeWdth = MrgeWdth + cc.ColumnWidth
Next
Application.ScreenUpdating = False
ma.MergeCells = False
c.ColumnWidth = MrgeWdth
c.EntireRow.AutoFit
NewRwHt = c.RowHeight
c.ColumnWidth = cWdth
ma.MergeCells = True
ma.RowHeight = NewRwHt
cWdth = 0: MrgeWdth = 0
Application.ScreenUpdating = True
End If
End With
End Sub
You could probably do something like this:
Surround your code with .Unprotect and .Protect
Sub protectSheet()
Dim ws As Worksheet
Set ws = Sheets(1)
With ws
.Unprotect "password"
'Insert Code Here
.Protect "password"
End With
End Sub
try this:
Private Sub Workbook_Open()
Dim wSheet As Worksheet
For Each wSheet In Worksheets
wSheet.Protect Password:="Password_here", _
UserInterFaceOnly:=True
Next wSheet
End Sub
Put this code in 'ThisWorkbook' then use the Workbook_Open Event.
This code protects all the WS everytime you open the WB
but allows macro to run due to UserInterfaceOnly set to true
You need to protect the sheet with password.
If you want a user to edit some cells even if the worksheet is protected then set the locked property of those cells to false before protecting the sheet.
Now when Worksheet_Change is triggered or any procedure is called which is trying to make some changes to excel range (locked cells = true) then you need to Unprotect the Sheet at beginning of the code and protect it at the end again. You may refer #sobin answer for syntax.
Also you may use error handlers and explicitly protect the sheet. This is done to avoid situation wherein the sheet is unprotected and then there is error which comes up for any reason then that would leave the sheets unprotected.

Excel-VBA Before Save Lock a range of cells

I am generating a Daily Planner Sheet in which i want to lock some appraisal cells after saving. I have written the following code in excel workbook code. The macro asks to enter password before saving. Why is it asking to enter the password?(I have 53 sheets for weekly planning. I have shown only 2 here)
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Sheets("Sheet18").Unprotect Password:="****"
Sheets("Sheet19").Unprotect Password:="****"
ActiveSheet.Protect Contents:=False
For Each Cell In Range("H5:H24,J5:J24")
If Cell <> "" Then Cell.Locked = True
If Cell = "" Then Cell.Locked = False
Next
ActiveSheet.Protect Contents:=True
Sheets("Sheet18").Protect Password:="****"
Sheets("Sheet18").Protect UserInterfaceOnly:=True
Sheets("Sheet19").Protect Password:="****"
Sheets("Sheet19").Protect UserInterfaceOnly:=True
End Sub
Your code will behave differently depending on the active sheet when saving.
Additionnaly, I wouldn't recommend to overload the reserved name "Cell" with a local loop variable. This will lead to unexpected behavior.
You should remove references to ActiveSheet.
If your wish is to protect the entire workbook, I would suggest iteration over the worksheets:
Sub ProtectAll()
Dim wSheet As Worksheet
Dim myCell As Range
For Each wSheet In Worksheets
wSheet.Unprotect Password:="****"
For Each myCell In Range("H5:H24,J5:J24")
myCell.Locked = (myCell <> "")
Next myCell
wSheet.Protect Contents:=True, Password:="****", UserInterfaceOnly:=True
Next wSheet
End Sub
NB: you have to put the code in a code module.