I have 5 worksheets in my excel workbook but I want specifically protect 3rd and 5th worksheets with password. Have below macro which protects only one sheet. what needs to be added to protect more than one sheet but not all sheets. Kindly guide me.
Thanks in Advance!!
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim MySheets As String, Response As String
MySheet = "Sheet1"
If ActiveSheet.Name = MySheet Then
ActiveSheet.Visible = False
Response = InputBox("Enter password to view sheet")
If Response = "pass" Then
Sheets(MySheet).Visible = True
Application.EnableEvents = False
Sheets(MySheet).Select
Application.EnableEvents = True
End If
End If
Sheets(MySheet).Visible = True
End Sub
Try this:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim MySheets As String, Response As String
MySheet = ActiveSheet.Name
Select Case MySheet
Case "Sheet1", "Sheet3", "Sheet5"
ActiveSheet.Visible = False
Response = InputBox("Enter password to view sheet")
If Response = "pass" Then
Sheets(MySheet).Visible = True
Application.EnableEvents = False
Sheets(MySheet).Select
Application.EnableEvents = True
End If
End Select
Sheets(MySheet).Visible = True
End Sub
But hardcoding the password doesnt make it that safe.
Related
I came across the following VBA function within this forum that works for password protecting one sheet, but I would like to password protect all sheets except two sheets:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim MySheets As String, Response As String
MySheet = "Sheet1"
If ActiveSheet.Name = MySheet Then
ActiveSheet.Visible = False
Response = InputBox("Enter password to view sheet")
If Response = "MyPass" Then
Sheets(MySheet).Visible = True
Application.EnableEvents = False
Sheets(MySheet).Select
Application.EnableEvents = True
End If
End If
Sheets(MySheet).Visible = True
End Sub
I have five sheets in my workbook ("Sheet1","Sheet2","Sheet3","Sheet4","Sheet5") and I would like all sheets to be password protected and hidden except Sheet1 and Sheet2. In other words, Sheet3, Sheet4, and Sheet5 should all be password protected with the above code
I've updated the function to be as follows, but it does not even show any other sheets even after entering the correct password
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim MySheets As String, Response As String
MySheet = "Sheet1"
MySheet2 = "Sheet2"
If ActiveSheet.Name <> MySheet And ActiveSheet.Name <> MySheet2 Then
ActiveSheet.Visible = False
Response = InputBox("Enter password to view sheet")
If Response = "MyPass" Then
Sheets(MySheet).Visible = True
Application.EnableEvents = False
Sheets(MySheet).Select
Application.EnableEvents = True
End If
End If
Sheets(MySheet).Visible = True
Sheets(MySheet2).Visible = True
End Sub
You aren't using the gifts that Workbook_SheetActivate is giving you. Sh is the worksheet object that is being activated.
Your variable declaration is henky; you declare Dim MySheets As String but never use it and assign MySheet = "Sheet1" and MySheet2 = "Sheet2" without declaring them.
Some levels of worksheet identification are better handled by the worksheet's codename property which changes much less frequently.
Option Explicit
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim response As String
If IsError(Application.Match(Sh.CodeName, Array("Sheet1", "Sheet2"), 0)) Then
Sh.Visible = xlSheetHidden
response = InputBox("Enter password to view sheet")
If response = "MyPass" Then
Application.EnableEvents = False
Sh.Visible = xlSheetVisible
Sh.Activate
Application.EnableEvents = True
End If
End If
Sheet1.Visible = True
Sheet2.Visible = True
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
If IsError(Application.Match(Sh.CodeName, Array("Sheet1", "Sheet2"), 0)) Then
Sh.Visible = xlSheetHidden
End If
End Sub
Another option is to tie to Named range. You create named range with sheet scope, like this, for example:
Name manager Ctrl+F3
Then you create additional function that to check if such name exists and get its value. Depending on the result the sheet will be hidden or not.
Public Function bIsVisible(ByRef wksSheet As Worksheet) As Boolean
Dim bResult As Boolean
bResult = False
On Error Resume Next
bResult = Evaluate(wksSheet.Names("Visible").Value)
bIsVisible = bResult
End Function
And here's to code for hiding the sheets (you can easily add here code for sheet protection etc.):
Public Sub HideUnvisible()
Dim wksSheet As Worksheet
For Each wksSheet In Worksheets
If Not bIsVisible(wksSheet) Then
wksSheet.Visible = xlSheetHidden
End If
Next wksSheet
End Sub
I am using the below code to retain sheets that I need and delete the rest.
Sub DeleteSheets1()
Dim xWs As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In Application.ActiveWorkbook.Worksheets
If xWs.Name <> "Sheet1" And xWs.Name <> "Sheet2" Then
xWs.Delete
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
I have around 6 sheets that I want to retain. I need help modifying the syntax to accommodate multiple sheets. Something like below
if xWs.Name <> ("sheet1", "sheet2"....) then xws.delete
Here arr is an array of the sheets to retain:
Sub DeleteSheets1()
Dim xWs As Worksheet, s As String, i As Long
Dim skp As Boolean
arr = Array("Sheet1", "Sheet2", "Sheet3")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
n = ActiveWorkbook.Worksheets.Count
For i = n To 1 Step -1
s = Sheets(i).Name
skp = False
For Each a In arr
If s = a Then skp = True
Next a
If Not skp Then Sheets(i).Delete
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
The valueInArray boolean function could work the code easier:
Public Function valueInArray(myValue As Variant, myArray As Variant) As Boolean
Dim cnt As Long
For cnt = LBound(myArray) To UBound(myArray)
If CStr(myValue) = CStr(myArray(cnt)) Then
valueInArray = True
Exit Function
End If
Next cnt
End Function
Sub DeleteSheets()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Dim cnt As Long
cnt = Worksheets.Count
Dim arrWks As Variant
arrWks = Array("Sheet1", "Sheet2", "Sheet3")
For cnt = Worksheets.Count To 1
If Not valueInArray(Worksheets(cnt).Name, arrWks) Then
Worksheets(cnt).Delete
End If
Next cnt
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
The valueInArray function gets value to search for myValue and array where to search for this value myArray. It loops through all elements of the array and if it finds the same String of the passed value, it returns True and exits. If it is not found, it returns False, as this is the default.
Another approach
Sub Test()
Dim ws As Worksheet
Dim arr As Variant
arr = Array("Sheet1", "Sheet2", "Sheet3")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Worksheets
If Not IsNumeric(Application.Match(ws.Name, arr, 0)) Then ws.Delete
Next ws
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Ok, this one doesn't quite fulfil the requirement of an array, but it's another way of using a single loop.
It looks for an occurrence of the sheet name in the RetainSheets string. Each sheet name is surrounded by | just in case there's a sheet name within a sheet name eet1Sh as an example.
The code will not attempt to delete the last worksheet in the workbook either.
Sub Test()
Dim wrkSht As Worksheet
Dim RetainSheets As String
RetainSheets = "|Sheet1|Sheet2|"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each wrkSht In Worksheets
If InStr(RetainSheets, wrkSht.Name) = 0 And Worksheets.Count > 1 Then
wrkSht.Delete
End If
Next wrkSht
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
I have written some code to hide and unhide sheets by changing values in the 1st worksheet, how can I make all sheets visible except for the first 2 sheets?
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("H5").Value = "ADMIN" Then
Sheets(2).Visible = True
Sheets(2).Activate
Else
Sheets(2).Visible = xlVeryHidden
End If
If Range("G8").Value = True And Range("H5").Value = "" Then
Sheets(3).Visible = True 'I want to visible all sheets except first two sheets.
Sheets(4).Visible = True
Sheets(1).Visible = xlVeryHidden
Sheets(2).Visible = xlVeryHidden
Else
Sheets(3).Visible = xlVeryHidden
Sheets(4).Visible = xlVeryHidden
End If
End Sub
What you need to do is to loop thorugh all Sheets in your workbook, and if your Sheet.Index is larger than 2, then make the sheet Visible.
See loop below :
Dim Sht As Worksheet
' loop through all worksheets in this workbook
For Each Sht In ThisWorkbook.Worksheets
If Sht.Index > 2 Then ' check if index > 2
Sht.Visible = xlSheetVisible
Else
Sht.Visible = xlVeryHidden
End If
Next Sht
Entire Code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sht As Worksheet
If Range("H5").Value = "ADMIN" Then
Sheets(2).Visible = True
Sheets(2).Activate
Else
Sheets(2).Visible = xlVeryHidden
End If
If Range("G8").Value = True And Range("H5").Value = "" Then
For Each Sht In ThisWorkbook.Worksheets
If Sht.Index > 2 Then
Sht.Visible = xlSheetVisible
End If
Next Sht
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sht As Worksheet
If Range("H5").Value = "ADMIN" Then
Sheets(2).Visible = True
Sheets(2).Activate
Else
Sheets(2).Visible = xlVeryHidden
End If
If Range("G8").Value = True And Range("H5").Value = "" Then
For Each Sht In ThisWorkbook.Worksheets
If Sht.Index > 2 Then
Sht.Visible = xlSheetVisible
Sheets(1).Visible = xlVeryHidden
' Else
' Sht.Visible = xlVeryHidden
End If
Next Sht
'Else
' Sheets(3).Visible = xlVeryHidden
' Sheets(4).Visible = xlVeryHidden
End If
End Sub
edited to reflect Adnan last code
you may try this code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iSht As Long
Sheets(2).Visible = xlVeryHidden '<--| you'll make it visible if the case (see below)
Select Case Range("H5").Value '<--| check for H5 cell only once
Case "ADMIN"
Sheets(2).Visible = True
Sheets(2).Activate
Case ""
If Range("G8").Value Then '<--| check for it only when H5 cell value <> "ADMIN"
For iSht = 3 To Sheets.count '<--| loop through sheets indexes greater than 2, and avoid 'If ... Then' check
Sheets(iSht).Visible = True
Next iSht
Sheets(1).Visible = xlVeryHidden '<--| hide first sheet only once
End If
End Select
End Sub
which does the same things as yours but some logic improvements:
doesn't check twice for Range("H5").Value
doesn't check for Range("G8").Value uselessly after Range("H5").Value is "ADMIN"
doesn't make the If Sht.Index > 2 Then check at every For Each Sht In ThisWorkbook.Worksheets loop
doesn't set Sheets(1).Visible = xlVeryHidden at every For Each Sht In ThisWorkbook.Worksheets loop
I have a code that deletes a tab in the worksheet then runs another code. I am currently running into an issue that if the sheet is not there the code gives me an error... I'm wondering if I could make an if statement that looks if the tab is there and if not it moves on and if it is there it will delete it. I have the code that I have written already posted below but I have no idea how to do the if in the delete section.
Thanks!
Sub delete()
Dim ws As Worksheet
Set ws = Worksheets("Workbench Report")
Application.DisplayAlerts = False
ws.delete
Call Sorting
End Sub
Check if the sheet exists first:
Sub delete()
Dim ws As Worksheet
If WorksheetExists("Workbench Report") Then
Set ws = Worksheets("Workbench Report")
Application.DisplayAlerts = False
ws.delete
Call Sorting
End If
End Sub
Public Function WorkSheetExists(SheetName As String, Optional WrkBk As Workbook) As Boolean
Dim wrkSht As Worksheet
If WrkBk Is Nothing Then
Set WrkBk = ThisWorkbook
End If
On Error Resume Next
Set wrkSht = WrkBk.Worksheets(SheetName)
WorkSheetExists = (Err.Number = 0)
Set wrkSht = Nothing
On Error GoTo 0
End Function
Try this
Sub delete()
Dim i As Integer
i = 1
Application.DisplayAlerts = False
While i <= ActiveWorkbook.Worksheets.Count
Sheets(i).Select
If ActiveSheet.Name = "Workbench Report" Then
ActiveSheet.delete
End If
i = i + 1
Wend
Call Sorting
Application.DisplayAlerts = True
End Sub
Using Excel 2013 macros I'd like to be able to, upon worksheet creation (the "+" sign or right click, new worksheet), to instead of creating a new worksheet, copy a hidden "TEMPLATE" worksheet instead to use as a template for this workbook. There will be many worksheets to be created initially and over time, this workbook will be used every day with potentially other workbooks open at the same time as well.
The code I already have asks for the user to input the name of the worksheet upon creation and calls to sort the current workbook's worksheets alphanumerically and rebuild the TOC. Is there any way to change the current code to match it's new purpose? NOTE: This code is in ThisWorkbook.
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim sName As String
Dim bValidName As Boolean
Dim i As Long
bValidName = False
Do While bValidName = False
sName = InputBox("Please name this new worksheet:", "New Sheet Name", Sh.Name)
If Len(sName) > 0 Then
For i = 1 To 7
sName = Replace(sName, Mid(":\/?*[]", i, 1), " ")
Next i
sName = Trim(Left(WorksheetFunction.Trim(sName), 31))
If Not Evaluate("ISREF('" & sName & "'!A1)") Then bValidName = True
End If
Loop
Sh.Name = sName
Call Sort_Active_Book
Call Rebuild_TOC
End Sub
Edit 1:
Note: The "TEMPLATE" worksheet only pertains to this workbook, does not need to be used in another workbook, and is a hidden worksheet in this workbook.
Updated code. GSerg has it right:
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim wb as Workbook
Dim wsTemp as Worksheet
Dim sName As String
Dim bValidName As Boolean
Dim i As Long
bValidName = False
Do While bValidName = False
sName = InputBox("Please name this new worksheet:", "New Sheet Name", Sh.Name)
If Len(sName) > 0 Then
For i = 1 To 7
sName = Replace(sName, Mid(":\/?*[]", i, 1), " ")
Next i
sName = Trim(Left(WorksheetFunction.Trim(sName), 31))
If Not Evaluate("ISREF('" & sName & "'!A1)") Then bValidName = True
End If
Loop
With Application
.ScreenUpdating = False
.DisplayAlerts = False
.EnableEvents = False
End With
Set wb = ThisWorkbook
Set wsTemp = wb.Sheets("TEMPLATE")
wsTemp.Visible = xlSheetVisible
wsTemp.Copy After:=wb.Sheets(wb.Sheets.Count)
ActiveSheet.Name = sName
Sh.Delete
wsTemp.Visible = xlSheetHidden 'Or xlSheetVeryHidden
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.EnableEvents = True
End With
Call Sort_Active_Book
Call Rebuild_TOC
End Sub
Is your template saved a location you could pull from for anyone who needs it? If not you will just have to create a macro to format a template.
If you have a template ready, you just need the full path of that file. I would turn off application.screenupdating = false and open that file, copy the sheet you want and paste it to your current doc, then close the template file and application.screenupdating = true.
Edit:
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Template").Visible = True
sheets("Template").copy after:=Sheets(1)
Sheets("Template").Visible = False
ActiveSheet.Name = sName
Sheets(Sh.Name).Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
This will work, you will just need to change the template path