I am having an issue regarding setting a range of cells to be editable by a user after my code runs when the file opens. The file gets a runtime error "Unable to set the locked property of the range class".
I have done some digging online and it appears other people have the same issue when their cells are merged. My cells aren't merged.
What I am trying to do:
Lock all cells on all sheets apart from specific ones
Still allow user to group and ungroup data
The code runs fine without selecting specific cells
Sub Workbook_Open()
Application.StatusBar = "Loading Please Wait..." 'change status bar text
Application.ScreenUpdating = False 'freeze screen
Application.Cursor = xlWait 'change cursor
UserForm1.Show vbModeless 'show loading form
UserForm1.Repaint 'update form
For Each ws In Sheets 'loop for every sheet
With ws
.Unprotect Password:="11Oceans" 'unprotect sheet
.Range("D6:J6").Locked = False 'format certain cells to unprotect -ERROR HERE
.Protect Password:="11Oceans", UserInterfaceOnly:=True 'protect sheet but leave data grouping
.EnableOutlining = True
End With
Next ws 'next worksheet
Application.ScreenUpdating = True 'return control to user
Application.StatusBar = "" 'return status bar to default
Application.Cursor = xlDefault 'return cursor to default
Unload UserForm1 'close loading form
End Sub
Related
I am currently trying to write a piece of code where someone is able to use a checkbox to choose which worksheets they would like to keep and what they would like removed. Here is what that looks like:
(currently debating if I should turn this into a userform but i would still be stuck at this point).
What I would like to do is if the checkbox is unchecked (false) on the worksheet called "Setup", delete the worksheet and move onto the next if statement. From the code below, I am prompt with the run-time error '1004': Unable to get the OLEObjects property of the worksheet class. I have checked and the Checkbox name is the same as what I have in my code.
Sub DeleteSheetCB()
If ThisWorkbook.Worksheets("Setup").OLEObjects("CheckBox1") = False Then
ThisWorkbook.Worksheets("Program Information").Delete
End If
If ThisWorkbook.Worksheets("Setup").OLEObjects("CheckBox2") = False Then
ThisWorkbook.Worksheets("Spend and Trx Data").Delete
End If
If ThisWorkbook.Worksheets("Setup").OLEObjects("CheckBox3") = False Then
ThisWorkbook.Worksheets("Requirements").Delete
End If
If ThisWorkbook.Worksheets("Setup").OLEObjects("CheckBox4") = False Then
ThisWorkbook.Worksheets("TMC Overview").Delete
End If
End Sub
Thank you in advance
EDIT:
I was able to get this piece of code to delete sheets but if possible, would someone be able to sense check this for me please?
Sub DeleteSheetCB()
If ThisWorkbook.Worksheets("Setup").Shapes("Check Box 1").ControlFormat.Value <> 1 Then
ThisWorkbook.Worksheets("Program Information").Delete
Else: End If
If ThisWorkbook.Worksheets("Setup").Shapes("Check Box 2").ControlFormat.Value <> 1 Then
ThisWorkbook.Worksheets("Spend and Trx Data").Delete
Else: End If
If ThisWorkbook.Worksheets("Setup").Shapes("Check Box 3").ControlFormat.Value <> 1 Then
ThisWorkbook.Worksheets("Requirements").Delete
Else: End If
If ThisWorkbook.Worksheets("Setup").Shapes("Check Box 4").ControlFormat.Value <> 1 Then
ThisWorkbook.Worksheets("TMC Overview").Delete
Else: End If
End Sub
The main thing I'd take from your second code is:
It will give you a warning before it deletes each sheet
You'll get a subscript out of range error if the sheet has already been deleted.
You have to update your code if you add a new tick box.
The code below assumes the caption of the checkbox is exactly the same as the name of the sheet to be deleted.
Sub DeleteSheetCB()
Dim chkBox As CheckBox
Dim sMissing As String
With ThisWorkbook.Worksheets("Setup")
For Each chkBox In .CheckBoxes 'Look at all checkboxes in Setup sheet.
If chkBox.Value = 1 Then 'If it's ticked.
If WorksheetExists(chkBox.Caption) Then 'Check worksheet exists.
Application.DisplayAlerts = False 'Turn off warnings about deleting a sheet.
ThisWorkbook.Worksheets(chkBox.Caption).Delete
Application.DisplayAlerts = True 'Turn on warnings about deleting a sheet.
Else
sMissing = sMissing & "- " & chkBox.Caption & vbCr
End If
End If
Next chkBox
End With
If sMissing <> "" Then
MsgBox "These sheet(s) could not be deleted as they were already missing: " & vbCr & vbCr & sMissing
End If
End Sub
Public Function WorksheetExists(SheetName As String) As Boolean
Dim wrkSht As Worksheet
On Error Resume Next
Set wrkSht = ThisWorkbook.Worksheets(SheetName) 'Try and set a reference to the sheet.
WorksheetExists = (Err.Number = 0) 'Was an error thrown?
On Error GoTo 0
End Function
Might also be worth mentioning that you can rename your checkboxes:
Select a check box so the Shape Format ribbon becomes visible.
Click Selection Pane under the Arrange section.
A sidebar will appear showing the shapes on the sheet. You can rename or change their visibility here.
chkRemoveProgramInfo makes more sense than Check Box 1.
I would like to write a code which, before closing the Workbook, sets all the sheets except one cover as very hidden.
I click on the "X" to close the Workbook, the Macro is fired and everything fine.
Then I receive the classic saving form of Excel and, if I click cancel, I receive error 91 - Object variable or With block variable not set.
Could someone explain me why is happening? I used the same code in the past and I did not have this issue
It is interesting because, if there is another excel workbook open at the same time, it works everything fine.
In Tab ThisWorkbook:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.EnableEvents = True
Call my_macro 'defined in a separate module
Application.EnableEvents = False
End Sub
For the sake of clarity in Module 1 the code is following:
Public Sub my_macro()
Application.ScreenUpdating = False
On Error GoTo skip
Dim ws As Worksheet
Sheet8.Visible = True
For Each ws In Worksheets
If ws.Name = "Cover" Then
Else
ws.Visible = xlSheetVeryHidden
End If
Next ws
Sheet8.Select
Range("A1").Select
Application.ScreenUpdating = True
ActiveSheet.EnableSelection = xlNoRestrictions
Application.EnableEvents = True
skip:
Application.EnableEvents = True
End Sub
Following on from a previous question I asked today - I have modified code written by Roy Cox (Thank you for saving me SO much time!) to create a userform to add, modify and delete users' details in an analysis tool I am creating.
It works perfectly when working with user data on a single worksheet.
Selecting a user and clicking 'delete' deletes their user data on the worksheet. I have modified the code so that when a user is added or deleted, it should check each worksheet and adds or deletes rows accordingly.
This is the code to delete the pupil data on a single sheet:
Private Sub cmbDelete_Click()
Dim msgResponse As String 'confirm delete
Application.ScreenUpdating = False
'get user confirmation
msgResponse = MsgBox("This will delete the selected record. Continue?", _
vbCritical + vbYesNo, "Delete Entry")
Select Case msgResponse 'action dependent on response
Case vbYes
'c has been selected by Find button on UserForm
Set c = ActiveCell
c.EntireRow.Delete 'remove entry by deleting row
'restore form settings
With Me
.cmbAmend.Enabled = False 'prevent accidental use
.cmbDelete.Enabled = False 'prevent accidental use
.cmbAdd.Enabled = True 'restore use
'clear form
Call ClearControls
End With
Case vbNo
Exit Sub 'cancelled
End Select
Application.ScreenUpdating = True
End Sub
I have tried modifying it to delete the user data on each worksheet, as follows:
Private Sub cmbDelete_Click()
Dim Sh As Worksheet
Dim msgResponse As String 'confirm delete
Application.ScreenUpdating = False
'get user confirmation
msgResponse = MsgBox("This will delete the selected record. Continue?", _
vbCritical + vbYesNo, "Delete Entry")
Select Case msgResponse 'action dependent on response
Case vbYes
For Each Sh In ThisWorkbook.Sheets
With Sh.UsedRange
'c has been selected by Find button
Set c = ActiveCell
c.EntireRow.Delete 'remove entry by deleting row
End With
Next
'restore form settings
With Me
.cmbAmend.Enabled = False 'prevent accidental use
.cmbDelete.Enabled = False 'prevent accidental use
.cmbAdd.Enabled = True 'restore use
'clear form
Call ClearControls
End With
Case vbNo
Exit Sub 'cancelled
End Select
Application.ScreenUpdating = True
End Sub
but this version deletes the user's data and the data on the 4 rows beneath them. It does not delete data from the next worksheet at all.
Can anyone offer any advice please?
change:
Case vbYes
For Each Sh In ThisWorkbook.Sheets
With Sh.UsedRange
'c has been selected by Find button
Set c = ActiveCell
c.EntireRow.Delete 'remove entry by deleting row
End With
Next
to:
Case vbYes
Dim l As Long
l = ActiveCell.Row 'store currently active cell row
For Each Sh In ThisWorkbook.Worksheets
Sh.Rows(l).Delete
Next
should you ever be interested in knowing why your previous code didn't work:
1)
Set c = ActiveCell
would set c to the currently active cell, i.e. the cell your "Find" button selected in the currently active sheet
2) while
c.EntireRow.Delete
would always, quite unsurprisingly, delete c entire row, i.e. the same row in the sheet where c has been found in, since nobody is setting c again and point to another sheet range.
and simply looping through Sheets collection doesn't change the Active sheet
I have an excel workbook containing several worksheets.
What I want to do is have a mechanism like a user form or something where the user would authenticate to one of several possible users.
Based on the username supplied I want to display certain worksheets and hide other sheets, and block the user from accessing worksheets they should not be able to view.
Has anyone done something like this in Excel?
Any thoughts are appreciated
Sean
I actually enjoyed the task of typing this one up. Keep in mind, VBE is not protected in this code so you may want to add some protection, but this should do what you need.
You should also create a generic Login worksheet. This would be the only sheet open before a password is entered. This is essential as you are unable to hide every sheet without throwing an error. (You need to have 1 visible sheet).
WARNING: This code is mildly tested. You are responsible for any loss of data for using the below code, such as (but not limited to) forgetting a password. You have been warned!!!!
1. Open the Workbook, then make a Call to GetLogin
Option Explicit
Private Sub Workbook_Open()
GetLogin 1
End Sub
2. The Login Code
Private Sub GetLogin(ByVal AttemptNumber As Integer)
Dim Sheet As Worksheet
With ThisWorkbook.Worksheets("Login")
.Visible = xlSheetVisible
.Activate
End With
For Each Sheet In ThisWorkbook.Sheets
If Not Sheet.Name = "Login" Then
Sheet.Visible = xlSheetVeryHidden
End If
Next Sheet
Dim Password As String
Password = Application.InputBox("Please enter your password")
Select Case Password
Case "Ma$terPas$"
For Each Sheet In ThisWorkbook.Sheets
Sheet.Visible = xlSheetVisible
Next Sheet
ThisWorkbook.Worksheets(1).Activate 'For when you hide login sheet
Case "Oth3Rpa$$"
With ThisWorkbook
.Worksheets(1).Visible = xlSheetVisible
End With
ThisWorkbook.Worksheets(1).Activate 'For when you hide login sheet
Case Else
If AttemptNumber <= 3 Then
If MsgBox("You entered an incorrect password", vbRetryCancel, "Attempt # " & AttemptNumber) = vbRetry Then
AttemptNumber = AttemptNumber + 1
GetLogin AttemptNumber
Else
ThisWorkbook.Saved = True
ThisWorkbook.Close
End If
Else
ThisWorkbook.Saved = True
ThisWorkbook.Close
End If
End Select
ThisWorkbook.Worksheets("Login").Visible = xlSheetHidden
End Sub
3. Close the Workbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If ThisWorkbook.Saved = False Then
If MsgBox("Would you like to save?", vbYesNo) = vbYes Then
ThisWorkbook.Save
End If
End If
Dim Sheet As Worksheet
With ThisWorkbook.Worksheets("Login")
.Visible = xlSheetVisible
.Activate
End With
For Each Sheet In ThisWorkbook.Sheets
If Not Sheet.Name = "Login" Then
Sheet.Visible = xlSheetVeryHidden
End If
Next Sheet
'Prevent from being asked to save the fact you just hid the sheets
ThisWorkbook.Saved = True
End Sub
Ensure that the Workbook_Open and Workbook_Close are in your Workbook's Module.
You could probably achieve this by using the Auto_Open event
Function Auto_Open()
Select Case True
Case InStr(Application.UserName, "Dan Smith") > 0
ActiveWorkbook.Sheets(1).Visible = xlSheetVeryHidden
Case InStr(Application.UserName, "Jon Doe") > 0
ActiveWorkbook.Sheets(1).Visible = True
End Select
End Function
Of course this would take a lot of work considering you'd have to find out everyone's usernames and then the sheets that you want to hide from them, but that's what I thought of
I have a short code that basically copies a selected row to another sheet, and deletes it from the first.
For some reason when I run this, it will run just fine, if I then select a different row, I get a pasteSpecial method of RangeClass failed error.
Sub Completed()
Dim trackerRow As Integer, compRow As Integer, answer As Integer
Application.ScreenUpdating = False
Application.CutCopyMode = False
trackerRow = ActiveCell.Row
compRow = Sheets("Completed").Cells(Rows.Count, "B").End(xlUp).Row
If trackerRow < 3 Then Exit Sub
If Cells(trackerRow, 2) = "" Then
MsgBox "This row is empty, please select the candidate you want to move.", vbExclamation, "Empty Row"
Else
answer = MsgBox("Are you sure you want to move " & Cells(trackerRow, 3).Value & "?", vbYesNo, "Confirm move?")
If answer = vbYes Then
'move row
Rows(trackerRow).EntireRow.Copy
With ThisWorkbook
With .Sheets("Completed")
.Activate
.Unprotect "HSBC2017"
.Cells(compRow + 1, 1).PasteSpecial xlPasteValues '**error line**.
.Protect "HSBC2017"
End With
With .Sheets("Tracker")
.Unprotect "HSBC2017"
.Rows(trackerRow).EntireRow.Delete
.Protect "HSBC2017"
.Activate
End With
End With
End If
End If
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub
I can't work out why when I open the document it will work once, but you have to re-open to run a second time?
Each time you crash into a debug, you leave the destination Completed worksheet unprotected. Closing the workbook and reopening it leaves it unprotected.
Unprotecting an unprotected worksheet does not cancel the .CutCopyMode but unprotecting a protected worksheet does.
So in the first run-through with an unprotected destination worksheet there is something on the clipboard (and you have 'dancing ants' on the row-to-copy on the Tracker worksheet). Since everything runs through, the destination Completed worksheet is now protected and a second run-through will cancel the .CutCopyMode when the worksheet is unprotected. You can watch this by stepping through your code with F8 and see the 'dancing ants' disappear from the copy area on the Tracker worksheet as soon as you unprotect the Completed worksheet a second time.
Possible solutions (with a nod to comments from Peh and Rory):
Protect the worksheet with a password and UserInterfaceOnly.
with worksheets("Completed")
.Protect Password:="HSBC2017", UserInterfaceOnly:=True
end with
This only has to be done once and you can remove both the .Unprotect and .Protect code from future sub procedure operations. Only actions made manually by the user will be restricted.
Initiate the copy from the source worksheet after unprotecting the destination worksheet.
with worksheets("Completed")
.Unprotect Password:="HSBC2017"
worksheets("Tracker").Rows(trackerRow).EntireRow.Copy
.Cells(compRow + 1, 1).PasteSpecial xlPasteValues
.Protect Password:="HSBC2017"
end with