VBA - Locking Cells Only Working In Some Cells and Not Others - excel

this project is certainly testing my limits in VBA. I have yet another question. In this workbook, I have a button called "Add Projects" that takes a different sheet "Project Templates" and uses it to create a new sheet called "Add Projects". I'm trying to add some specific cell locking when this sheet is created. The idea is that users can alter certain areas, but not ones that have formulas or are auto-populated by an entry in a different cell.
The problem is, when I add the code, certain ones lock appropriately, one particular cell does a popup asking for a password (when it should just be locked like the others), and some let you still edit them despite them being included in the locked code.
I've checked the cell format, and the box for locked is selected. I've also gone to the Allow Users to Edit Ranges and removed everything from there (although those ranges weren't in there). I've moved the order of the ranges around, thinking maybe they were somehow overwriting each other even though I have a distinct cell set as the end range.
Public Sub Open_AddProjectSheet()
Application.ScreenUpdating = False
ActiveWorkbook.Unprotect Password:="Password"
Worksheets("ProjTemplate").Visible = True
If WorksheetExists("AddProject") = False Then
GetTSResourceInfo
GetTSProjectID
ActiveWorkbook.Unprotect Password:="Password"
Worksheets("ProjTemplate").Copy After:=Worksheets("ProjTemplate")
ActiveSheet.Name = "AddProject"
Worksheets("ProjTemplate").Visible = xlSheetVeryHidden
Sheets("AddProject").Activate
ActiveSheet.Unprotect Password:="Password"
ActiveSheet.Cells.Locked = False
ActiveSheet.Range("E5,C6,L2,L6").Locked = True
ActiveSheet.Range("E11:E190").Locked = True
ActiveSheet.Range("G11:H190").Locked = True
ActiveSheet.Range("K2:K6").Locked = True
ActiveSheet.Range("L11:R190").Locked = True
ActiveSheet.Range("L3:L5").Locked = False
ActiveSheet.Protect Password:="Password",UserInterFaceOnly:=True,Contents:=True
Else
answer = MsgBox("'AddProject' sheet already active. Would you like to pick up where you left? WARNING: Selecting 'No' will close the existing sheet and open a new one, any progress will not be saved.", vbYesNo)
If answer = 6 Then
Worksheets("AddProject").Activate
Else
*Same code as above*
End If
End If
Worksheets("ProjTemplate").Visible = xlSheetVeryHidden
ActiveWorkbook.Protect Password:="Password"
Application.ScreenUpdating = True
End Sub
When running this code, E5,C6,K2-K6,L2,L11-R190 are all locked correctly. L6 brings up a popup asking for a password to change this cell. All other ranges, E11-E190, G11-H190 are editable even though they should be locked.
Any ideas I'm greatly appreciative of. Thanks!

So, even though it didn't work before, we went back and tried to alter the Allow Users to Edit Ranges. Wiped all of them out again and the cell locking started working. I'm not going to question why it worked vs not working the last time it was tried, just glad it's working! That being said, the speed being different is still an issue.

Related

Excel VBA: How to dynamically enlarge/expand ActiveCell?

I ran across a question in a facebook group which asked how to expand/enlarge/zoom the active cell in an Excel worksheet.
Normally, I don't like to mess with the Excel UI visually but I guess that the person must have some form of visual impairment or something which requires a clear and bigger view of the contents of the active cell.
I searched in stackoverflow and googled and also in the similar questions box which doesn't show the exact same answer I was searching.
I believe that there are multiple possible approaches to this question.
1.to change the rowHeight and columnWidth of the activecell.
Application.ActiveCell.RowHeight=50
Application.ActiveCell.ColumnWidth=50
2.to change the autofit of the column containing activecell.
Application.ActiveCell.EntireColumn.AutoFit
3.to change the zoom level of activewindow.
ActiveWindow.Zoom 50
4.to assign the activecell contents into a textbox.text property on a modeless userform.
I think methods 1 & 4 are most likely to work and personally, I prefer method4 because it seems less likely to visually disturb the user.
Workbook_SheetSelectionChange "event will be used
Allow me to answer to my own question with the following VBA code.
Please feel free to improve upon this.
'copy paste into ThisWorkbook module
'explicit error checking was not performed - use at users' own risk
Option Explicit
Const increasedColumnWidth = 50'change how large as per requirement
Const increasedRowHeight = 50
'saved properties to restore later
Private saved_ActiveCell_ColumnWidth As Integer
Private saved_ActiveCell_RowHeight As Integer
Private saved_ActiveCell As Range
'can also be placed into individual worksheet modules but used ThisWorkbook to cover newly inserted sheets
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'very important that sh must be a worksheet<-not checked here
' If Sh.Name = "Sheet1" Then 'set sheet name here to limit to Sheet1 only or any particular sheet
If Target.Cells.CountLarge = 1 Then 'if .Count, there may be overflow
Application.ScreenUpdating = False 'to reduce flashing
If Target.Value <> "" Then 'or isempty(target.value)
'restoring previous activecell if there's one
If Not saved_ActiveCell Is Nothing Then
saved_ActiveCell.EntireColumn.ColumnWidth = saved_ActiveCell_ColumnWidth
saved_ActiveCell.EntireRow.RowHeight = saved_ActiveCell_RowHeight
End If
'backup
Set saved_ActiveCell = Target 'Application.ActiveCell
saved_ActiveCell_ColumnWidth = Target.ColumnWidth
saved_ActiveCell_RowHeight = Target.RowHeight
'expanding
Target.EntireRow.RowHeight = increasedRowHeight
Target.EntireColumn.ColumnWidth = increasedColumnWidth
Else'if activecell doesn't contain any value, restore previous activecell to previous size
If Not saved_ActiveCell Is Nothing Then
saved_ActiveCell.EntireColumn.ColumnWidth = saved_ActiveCell_ColumnWidth
saved_ActiveCell.EntireRow.RowHeight = saved_ActiveCell_RowHeight
End If
End If
Application.ScreenUpdating = True
End If
' End If
End Sub
Sharing this code doesn't mean that I support messing around with Excel UI manipulation especially those that would disturb the user.
The provided code is just for changing activecell's rowHeight and columnWidth to give the user the visual effect that the activecell is expanded/enlarged.
I've seen other code that would create an image of activecell on-the-fly and gives the user the impression of a zoomed cell here.
The code shared herewith is only for manipulating the rowHeight and columnWidth of the ActiveCell.
The method dealing with a textbox on a modeless userform is still getting improvements and will eventually be available(probably) on my GitHub as a .xlsm file.
Also uploaded a .gif below to clearly display the requirements and the results.
This video .gif contains features not available in the code shared here.

VBA crashes when adding formula to multiple cells

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

VBA Enable Events not working as expected

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!

Launch a different sheet by Spin button

want to use a Spin button (ActiveX Control) to show a previous or next sheet. When the button is clicked the event is successfully triggered and the desired sheet is activated but it holds some elements (commands, graphs, etc.,) from the original sheet and shows these as an appending picture.
Sample code for Down button event :
Private Sub SpinButton_JumpToWeek_SpinDown()
Dim sh_num As String
Dim tmp_num As Integer
Application.ScreenUpdating = False
Application.EnableEvents = False
SpinButton_JumpToWeek.Value = Range("B27").Value - 1
tmp_num = SpinButton_JumpToWeek.Value
' Activate desired KTx sheet
sh_num = "KT" & tmp_num
Range("F27").Value = "" 'reset to blank
Sheets(sh_num).Activate
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
To override this effect I have to manually select (activate) another sheet and then again select the desired sheet. I tried also to automatize this workaround with a macro, but unfortunately it does not work.
It is interesting that this problem do not occur if I execute code in Debug mode (using breakpoint and the stepping line by line).
Surprisingly, I do not have such problem if I try to show the previous/next sheet by writing a value (sheet name index) into a defined cell (i.e. using the Worksheet_Change event). The desired page is correctly shown. See photos.
Sample code for this evententer image description here:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh_num As String
Application.ScreenUpdating = False
Application.EnableEvents = False
If Range("F27").Value > 0 Then
' Activate desired KTx sheet
sh_num = "KT" & Range("F27").Value
Range("F27").Value = "" 'reset to blank
Sheets(sh_num).Activate
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
I need to use the Spin button because it is faster and allow me to skip some sheets (for example if these do not have data).
The problem occurs in both 32 and 64-bit Excel.
Do somebody an idea why this problem is occurring and a workaround? Do I have to change some settings or system properties in Excel? Any help would be highly appreciated.
#mehow
I append my commenst here due to large number of words.
I followed your suggestion and tried the example of a UserForm with inserted active control “Microsoft Office Spreadsheet”. I found out that this would not be a good solution for my case, because the response of such sheet is relatively slow (even on a fast PC like mine) when user inserts values into cells. Furthermore, this would greatly complicate my fairly simple *.xlsm workbook, which has more than 50 sheets (1 sheet for each week, the contents of these sheets are then linked to a main sheet), and completely meets my basic necessities (with the exception of this spin button of course).
In my opinion there is probably necessary to manipulate some kind of system property (like for e.g. Application.ScreenUpdating trick), but I do not have enough VBA knowledge to find it.
To clearly explain my question I would need to share my sample workbook, but I do not know how to upload it to this forum. Unfortunately, I am not able upload/show images successfully on this forum (due to my low rating), which would also help a lot.
BTW, I cannot see images on other questions of this forum, too. . Could this problem occur due to missing plugins in a web browser?
You can use a simple trick... before the "Application.screenupdating = true" you can insert the two lines:
ActiveWindow.SmallScroll Down:=-100
ActiveWindow.SmallScroll Up:=100

How to lock specific cells but allow filtering and sorting

I'm using the following code to lock the content of certain cells
Sub LockCell(ws As Worksheet, strCellRng As String)
With ws
.Unprotect
.Cells.Locked = False
.Range(strCellRng).Locked = True
.Protect Contents:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, DrawingObjects:=True
End With
End Sub
It locks the content of those specific columns. The problem is users cannot sort, neither filter, nor apply borders to the cells since those Excel menu items are disabled.
I thought the AllowSorting:=True, AllowFiltering:=True and DrawingObjects:=True would allow that the same way the AllowFormattingColumns:=True and AllowFormattingRows:=True allowed resizing.
There are a number of people with this difficulty. The prevailing answer is that you can't protect content from editing while allowing unhindered sorting. Your options are:
1) Allow editing and sorting :(
2) Apply protection and create buttons with code to sort using VBA. There are other posts explaining how to do this. I think there are two methods, either (1) get the code to unprotect the sheet, apply the sort, then re-protect the sheet, or (2) have the sheet protected using UserInterfaceOnly:=True.
3) Lorie's answer which does not allow users to select cells (https://stackoverflow.com/a/15390698/269953)
4) One solution that I haven't seen discussed is using VBA to provide some basic protection. For example, detect and revert changes using Worksheet_Change. It's far from an ideal solution however.
5) You could keep the sheet protected when the user is selecting the data and unprotected when the user has the header is selected. This leaves countless ways the users could mess up the data while also causing some usability issues, but at least reduces the odds of pesky co-workers thoughtlessly making unwanted changes.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If (Target.row = HEADER_ROW) Then
wsMainTable.Unprotect Password:=PROTECTION_PASSWORD
Else
wsMainTable.Protect Password:=PROTECTION_PASSWORD, UserInterfaceOnly:=True
End If
End Sub
This was a major problem for me and I found the following link with a relatively simple answer. Thanks Voyager!!!
Note that I named the range I wanted others to be able to sort
Unprotect worksheet
Go to "Protection"--- "Allow Users to Edit Ranges" (if Excel 2007, "Review" tab)
Add "New" range
Select the range you want allow users to sort
Click "Protect Sheet"
This time, *do not allow users to select "locked cells"**
OK
http://answers.yahoo.com/question/index?qid=20090419000032AAs5VRR
I just came up with a tricky way to get almost the same functionality. Instead of protecting the sheet the normal way, use an event handler to undo anything the user tries to do.
Add the following to the worksheet's module:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Locked = True Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
End Sub
If the user does anything to change a cell that's locked, the action will get immediately undone. The temporary disabling of events is to keep the undoing itself from triggering this event, resulting in an infinite loop.
Sorting and filtering do not trigger the Change event, so those functions remain enabled.
Note that this solution prevents changing or clearing cell contents, but does not prevent changing formats. A determined user could get around it by simply setting the cells to be unlocked.
Here is an article that explains the problem and solution with alot more detail:
Sorting Locked Cells in Protected Worksheets
The thing to understand is that the purpose of locking cells is to prevent them from being changed, and sorting permanently changes cell values. You can write a macro, but a much better solution is to use the "Allow Users to Edit Ranges" feature. This makes the cells editable so sorting can work, but because the cells are still technically locked you can prevent users from selecting them.
I know this is super old, but comes up whenever I google this issue. You can unprotect the range as given in the above cells and then add data validation to the unprotected cells to reference something outrageous like "423fdgfdsg3254fer" and then if users try to edit any those cells, they will be unable to, but you're sorting and filtering will now work.
Lorie's answer is good, but if a user selects a range that contains locked and unlocked cells, the data in the locked/protected cells can be deleted.
Isaac's answer is great, but doesn't work if the user highlights a range that has both locked and unlocked cells.
I modified Isaac's code a bit to undo changes if ANY of the cells in the target range are locked. It also displays a message explaining why the action was undone. Combined with Lorie's answer, I was able to achieve the desired result of being able to sort/filter a protected sheet, while still allowing a user to make changes to an unprotected cell.
Follow the instructions in Lorie's answer, then put the following code in the worksheet module:
Private Sub Worksheet_Change(ByVal Target As Range)
For Each i In Target
If i.Locked = True Then
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
MsgBox "Your action was undone because it made changes to a locked cell.", , "Action Undone"
Exit For
End If
Next i
End Sub
If the autofiltering is part of a subroutine operation, you could use
BioSum.Unprotect "letmein"
'<Your function here>
BioSum.Cells(1, 1).Activate
BioSum.Protect "letmein"
to momentarily unprotect the sheet, filter the cells, and reprotect afterwards.
This is a very old, but still very useful thread. I came here recently with the same issue. I suggest protecting the sheet when appropriate and unprotecting it when the filter row (eg Row 1) is selected. My solution doesn't use password protection - I don't need it (its a safeguard, not a security feature). I can't find an event handler that recognizes selection of a filter button - so I gave the instruction to my users to first select the filter cell then click the filter button. Here's what I advocate, (I only change protection if it needs to be changed, that may or may not save time - I don't know, but it "feels" right):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const FilterRow = 1
Dim c As Range
Dim NotFilterRow As Boolean
Dim oldstate As Boolean
Dim ws As Worksheet
Set ws = ActiveSheet
oldstate = ws.ProtectContents
NotFilterRow = False
For Each c In Target.Cells
NotFilterRow = c.Row <> FilterRow
If NotFilterRow Then Exit For
Next c
If NotFilterRow <> oldstate Then
If NotFilterRow Then
ws.Protect
Else
ws.Unprotect
End If
End If
Set ws = Nothing
End Sub
In Excel 2007, unlock the cells that you want enter your data into. Go to Review
> Protect Sheet
> Select Locked Cells (already selected)
> Select unlocked Cells (already selected)
> (and either) select Sort (or) Auto Filter
No VB required
I had a simular problem. I wanted the user to be able to filter "Table3" in a
protected worksheet. But the user is not able to edit the table. I accomplished above,
using the vba code below:
Range("Table3").Select
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, allowfiltering:=True
In the following code I filtered the code using VBA:
Range("Table3[[#Headers],[Aantal4]]").Select
ActiveSheet.ListObjects("Table3").Range.AutoFilter Field:=8, Criteria1:= _
Array("1", "12", "2", "24", "4", "6"), Operator:=xlFilterValues

Resources