I am using this code to test whether worksheets are password protected in the specified workbook objXL.
Function IsProtected(objXL As Object) As Boolean
Dim wksht As Excel.Worksheet
Dim cell As Excel.Range
Select Case TypeName(objXL)
Case "Worksheet"
If objXL.ProtectContents Then
IsProtected = True
Exit Function
End If
Case "Workbook"
If objXL.ProtectStructure Then
IsProtected = True
Exit Function
End If
For Each wksht In objXL.Worksheets
If wksht.ProtectContents Then
IsProtected = True
Exit Function
End If
Next wksht
Case "Range"
If objXL.Cells.Count = 1 Then
If (objXL.Locked And objXL.Parent.ProtectContents) Or (IsProtected(objXL.Parent.Parent)) Then
IsProtected = True
Exit Function
End If
Else
For Each cell In objXL
If (cell.Locked And cell.Parent.ProtectContents) Or (IsProtected(cell.Parent.Parent)) Then
IsProtected = True
Exit Function
End If
Next cell
End If
End Select
End Function
The function fails to detect chart sheets that are password protected. Any ideas how I can modify this?
I believe it should work if you loop through all the sheets instead of all the worksheets (which don't include chart sheets). Try running the codes below in a workbook with chart sheets and see the difference.
Sub wkshts()
For Each ws In Worksheets
Name = Name & " " & ws.Name & vbNewLine
Next
MsgBox Name
End Sub
Sub shts()
For Each ws In sheets
Name = Name & " " & ws.Name & vbNewLine
Next
MsgBox Name
End Sub
Related
I'm currently trying to detect duplicated sheet name using "CheckSheet" function. And I want to call this function to run in "Add Sheet" to prevent users from creating duplicate sheet names. However, I ran into error "Compile Error: Expected function or variable" and still not succeeding in solving the problem. Kindly enlighten me where I am doing it wrong and feel free to point out if there are any weakness and better optimization to my code. Thanks in advance.
Option Explicit
Public sheetName As Variant
Public cS As Variant
Sub CheckSheet(cS) 'To check duplicate sheet name - used in AddSheet function.
Dim wS As Worksheet
Dim wsName As String
wsName = wS(sheetName)
On Error GoTo 0
If wS Is Nothing Then
cS = False
Exit Sub
End Sub
Sub AddSheet()
Dim cSheet As Variant
cSheet = CheckSheet(cS).Value
On Error Resume Next
sheetName = Application.InputBox(prompt:="New Sheet Name", Left:=(Application.Width / 2), Top:=(Application.Height / 2), Title:="Add Sheet", Type:=2)
If sheetName = "" Then
MsgBox "Sheet name cannot be empty!"
Exit Sub
ElseIf cSheet = False Then
MsgBox "Duplicate Name! Please try again!"
Exit Sub
Else
Application.ScreenUpdating = False
Sheets.Add(After:=Sheets(Sheets.Count)).Name = sheetName
MsgBox """" & sheetName & """ was successfully created!"
Sheets("Sheet1").Activate
End If
End Sub
Two things.
1. Your code can be simplified. You do not need a function to check if a worksheet exists.
Option Explicit
Sub AddSheet()
Dim sh As Object
Dim sheetName As Variant
'~~> Accept user input
sheetName = Application.InputBox(prompt:="New Sheet Name", _
Left:=(Application.Width / 2), _
Top:=(Application.Height / 2), _
Title:="Add Sheet", Type:=2)
'~~> User presses cancel
If sheetName = False Then Exit Sub
'~~> Check if the sheet name is empty
If sheetName = "" Then
MsgBox "Sheet name cannot be empty!"
Exit Sub
End If
'~~> Check if the sheet exists
On Error Resume Next
Set sh = ThisWorkbook.Sheets(sheetName)
On Error GoTo 0
If Not sh Is Nothing Then
MsgBox "Duplicate Name! Please try again!"
Exit Sub
End If
'~~> Create the worksheet
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = sheetName
MsgBox """" & sheetName & """ was successfully created!"
End With
End Sub
2. Even if you want to use a function, your code has lot of errors. (One of them is pointed out by #braX above.
Is this what you are trying?
Option Explicit
Sub AddSheet()
Dim sheetName As Variant
'~~> Accept user input
sheetName = Application.InputBox(prompt:="New Sheet Name", _
Left:=(Application.Width / 2), _
Top:=(Application.Height / 2), _
Title:="Add Sheet", Type:=2)
'~~> User presses cancel
If sheetName = False Then Exit Sub
'~~> Check if the sheet name is empty
If sheetName = "" Then
MsgBox "Sheet name cannot be empty!"
Exit Sub
End If
'~~> Check if the sheet exists
If DoesSheetExists(CStr(sheetName)) = True Then
MsgBox "Duplicate Name! Please try again!"
Exit Sub
End If
'~~> Create the worksheet
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = sheetName
MsgBox """" & sheetName & """ was successfully created!"
End With
End Sub
'~~> Function to check if sheet exists
Private Function DoesSheetExists(wsName As String) As Boolean
Dim sh As Object
'~~> Check if the sheet exists
On Error Resume Next
Set sh = ThisWorkbook.Sheets(wsName)
On Error GoTo 0
If Not sh Is Nothing Then DoesSheetExists = True
End Function
I'm adding a new worksheet to my workbook with
Application.ScreenUpdating = False
SheetExists = False
For Each WS In Worksheets
If WS.Name = "BLANK" Then
SheetExists = True
End If
Next WS
If Not SheetExists Then
Sheets.Add
ActiveSheet.Name = "BLANK"
End If
Is there any way to sheets.add silently without bringing focus to or activating the new added sheet? I just want to stay on the sheet (ie. Sheet1) that is currently active and add the new sheet in the background.
Thanks
At first, things look simple but there are a few things to consider:
There could be more sheets selected before running the code
The selected sheet(s) could be Chart sheet(s)
The Workbook can be protected
You might not want to set Application.ScreenUpdating = True at the end of the method because you might be running this from within another method that still needs it off
Restoring selection can only happen if the proper window is activated
You could use this method:
Sub AddWorksheet(ByVal targetBook As Workbook, ByVal sheetname As String)
Const methodName As String = "AddWorksheet"
'Do input checks
If targetBook Is Nothing Then
Err.Raise 91, methodName, "Target Book not set"
ElseIf sheetname = vbNullString Then
Err.Raise 5, methodName, "Sheet name cannot be blank"
ElseIf Len(sheetname) > 31 Then
Err.Raise 5, methodName, "Sheet name cannot exceed 31 characters"
Else
Dim arrForbiddenChars() As Variant
Dim forbiddenChar As Variant
arrForbiddenChars = Array(":", "\", "/", "?", "*", "[", "]")
For Each forbiddenChar In arrForbiddenChars
If InStr(1, sheetname, forbiddenChar) > 0 Then
Err.Raise 5, methodName, "Sheet name cannot contain characters: : \ / ? * [ or ]"
End If
Next forbiddenChar
End If
Dim alreadyExists As Boolean
'Check if a sheet already exists with the desired name
On Error Resume Next
alreadyExists = Not (targetBook.Sheets(sheetname) Is Nothing)
On Error GoTo 0
If alreadyExists Then
MsgBox "A sheet named <" & sheetname & "> already exists!", vbInformation, "Cancelled" 'Can remove
Exit Sub
End If
'Check if Workbook is protected
If targetBook.ProtectStructure Then
'Maybe write code to ask for password and then unprotect
'
'
'Or simply exit
MsgBox "Workbook is protected. Cannot add sheet", vbInformation, "Cancelled"
Exit Sub
End If
Dim bookActiveWindow As Window
Dim appActiveWindow As Window
Dim selectedSheets As Sheets
Dim screenUpdate As Boolean
Dim newWSheet As Worksheet
'Store state
Set bookActiveWindow = targetBook.Windows(1)
Set appActiveWindow = Application.ActiveWindow 'Can be different from the target book window
Set selectedSheets = bookActiveWindow.selectedSheets
screenUpdate = Application.ScreenUpdating
'Do main logic
screenUpdate = False
If bookActiveWindow.Hwnd <> Application.ActiveWindow.Hwnd Then
bookActiveWindow.Activate
End If
If selectedSheets.Count > 1 Then selectedSheets(1).Select Replace:=True
Set newWSheet = targetBook.Worksheets.Add
newWSheet.Name = sheetname
'Restore state
selectedSheets.Select Replace:=True
If appActiveWindow.Hwnd <> Application.ActiveWindow.Hwnd Then
appActiveWindow.Activate
End If
Application.ScreenUpdating = screenUpdate
End Sub
If you want the book containing the code then you can call with:
Sub Test()
AddWorksheet ThisWorkbook, "BLANK"
End Sub
or, if you want the currently active book (assuming you are running this from an add-in) then you can call with:
Sub Test()
AddWorksheet ActiveWorkbook, "BLANK"
End Sub
or any other book depending on your needs.
Just remember who was active:
Sub ytrewq()
Dim wsh As Worksheet, SheetsExist As Boolean
Set wsh = ActiveSheet
Application.ScreenUpdating = False
SheetExists = False
For Each ws In Worksheets
If ws.Name = "BLANK" Then
SheetExists = True
End If
Next ws
If Not SheetExists Then
Sheets.Add
ActiveSheet.Name = "BLANK"
End If
wsh.Activate
Application.ScreenUpdating = False
End Sub
I'm having an issue with below. My code is basically a sorting function, where it pulls data from another sheet in order to give the user the correct view, however if the user selects the same product twice, my code produces an error since the information sheet is already in the workbook.
Therefore I simply want it to select the sheet, if the sheet is already in the workbook instead of running the code once more.
My issue is, that sometimes the sheet name will have more than 31 characters, which is why I use the left/len function. The problem is that it doesn't recognize the existing sheet name as
Left(Myvalue & " Case Types", 31)
and therefore just runs the code even though sheet already exist and therefore produces an error. When tabbing through the code with F8 I can see that the name should be same. Any suggestions?
Dim S As Worksheet
Myvalue = activecell.Value
For Each S In ActiveWorkbook.Worksheets
If S.Name = Left(Myvalue & " Case Types", 31) Then GoTo Sheetalreadyexist
Next S
'Create New Sheet
Set ws = Sheets.Add(after:=Sheets(Worksheets.Count))
If Len(Myvalue & " Case Types") > 31 Then
ws.Name = Left(Myvalue & " Case Types", 31)
Else: ws.Name = Myvalue & " Case Types"
End If
Sheetalreadyexist: sheets(Left(Myvalue & " Case Types", 31).select
I would use the following function to check if a sheet exists or not
Public Function sheetExists(SheetName As String, Optional wrkBook As Workbook) As Boolean
If wrkBook Is Nothing Then
Set wrkBook = ActiveWorkbook 'or ThisWorkbook - whichever appropriate
End If
On Error GoTo EH
sheetExists = False ' Not really neccessary as this is the default
Dim sht As Object
For Each sht In wrkBook.Sheets
If UCase(sht.Name) = UCase(SheetName) Then
sheetExists = True
Exit For
End If
Next sht
Exit Function
EH:
sheetExists = False
End Function
Then your code would look like that
Sub OP_Code()
Dim S As Worksheet
Myvalue = ActiveCell.Value
If sheetExists(Left(Myvalue & " Case Types", 31)) Then
Sheets(Left(Myvalue & " Case Types", 31)).Select
Else
'Create New Sheet
Set ws = Sheets.Add(after:=Sheets(Worksheets.Count))
If Len(Myvalue & " Case Types") > 31 Then
ws.Name = Left(Myvalue & " Case Types", 31)
Else: ws.Name = Myvalue & " Case Types"
End If
End If
End Sub
Quicker version
Public Function sheetExists(SheetName As String, Optional wrkBook As Workbook) As Boolean
If wrkBook Is Nothing Then
Set wrkBook = ActiveWorkbook 'or ThisWorkbook - whichever appropriate
End If
On Error GoTo EH
Dim sht As Worksheet
set sht = wrkbook.worksheets(sheetname) 'will cause error if sheetname doesn't exist
Set sht = nothing
SheetExists=true
Exit Function
EH:
sheetExists = False
End Function
I have a workbook with many sheets. I am webscraping with numbers, and then making each sheet have the number as the name. I want to display an error if the number has already been given to a sheet. I also want the user to be able to enter a new sheetname if so, but the program keeps popping up its own error message before I can do this.
The number is in cell D10 in the worksheet.
For Each Sheet In ThisWorkbook.Sheets
If Sheet.Name = Range("D10") Then
MsgBox ("ERROR: This Acct No has already been formulated")
NewName = InputBox("Please Rename:")
ActiveSheet.Name = NewName
ElseIf Sheet.Name <> Range("D10") Then
ActiveSheet.Name = Range("D10")
End If
Next Sheet
I expect my own message to pop up, but Excel just pops its own error message.
try this:
Dim MyDuplicate as boolean
MyDuplicate = False
For Each Sheet In ThisWorkbook.Sheets
If Sheet.Name = Range("D10") Then
MsgBox ("ERROR: This Acct No has already been formulated")
NewName = InputBox("Please Rename:")
ActiveSheet.Name = NewName
MyDuplicate = True
Exit for
End If
Next Sheet
If MyDuplicate = False then ActiveSheet.Name = Range("D10")
BTW, I do recommend you avoid using ActiveSheet and assign the sheet to a variable instead.
Option Explicit
Sub TestMe()
Dim wks As Worksheet
Worksheets.Add After:=ActiveSheet
For Each wks In ThisWorkbook.Worksheets
With wks
If .Name = .Range("D10") Then
MsgBox ("ERROR: This Acct No has already been formulated")
.Name = InputBox("Please Rename:")
ElseIf .Name <> .Range("D10") Then
If Trim(.Range("D10")) = "" Then
.Range("D10") = Replace(Replace(Now, ":", "_"), "/", "_")
Application.Wait Now + #12:00:02 AM#
End If
.Name = .Range("D10").Value
End If
End With
Next wks
End Sub
This is some idea how to do it, avoiding the Activate and Select, as per the How to avoid using Select in Excel VBA
(Ironically, I have left Worksheets.Add After:=ActiveSheet)
The part .Range("D10") = Replace(Replace(Now, ":", "_"), "/", "_") writes the current date and time, making sure it is always a unique one, by waiting 2 seconds on the next line - Application.Wait Now + #12:00:02 AM#
Rather than looping every sheet to check for duplicates, create a function that returns a boolean. This function will have an error if the sheet doesn't exist, and no error if the sheet does exist. We check for that error, and return True if sheet exists, False otherwise.
Option Explicit
Private Function SheetExists(wsName As String, Optional wb As Workbook = Nothing) As Boolean
Dim ws As Worksheet
On Error Resume Next
If wb Is Nothing Then
Set ws = Worksheets(wsName)
Else
Set ws = wb.Worksheets(wsName)
End If
SheetExists = (Err.Number = 0)
End Function
And then your code could be replaced with the following, which will keep calling on the InputBox as many times as necessary in order to prevent the user from inputting another invalid/duplicate entry. For this, I've combined the MsgBox and InputBox text, seems unnecessary to throw two prompts at the user when we can use the InputBox to both inform and ask for new input.
Dim ws as Worksheet
Dim newName as String
Set ws = ActiveSheet ' would be better to avoid this, but OK.
newName = Range("D10").Value
While SheetExists(newName, ws.Parent)
newName = InputBox("ERROR: This Acct No has already been formulated!" & vbCrLf & vbCrLf & _
newName & " already exists! Enter new name:")
Wend
ws.Name = newName
I am trying to add an Excel sheet named "Temp" at the end of all existing sheets, but this code is not working:
Private Sub CreateSheet()
Dim ws As Worksheet
ws.Name = "Tempo"
Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
End Sub
Can you please let me know why?
Try this:
Private Sub CreateSheet()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = "Tempo"
End Sub
Or use a With clause to avoid repeatedly calling out your object
Private Sub CreateSheet()
Dim ws As Worksheet
With ThisWorkbook
Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
ws.Name = "Tempo"
End With
End Sub
Above can be further simplified if you don't need to call out on the same worksheet in the rest of the code.
Sub CreateSheet()
With ThisWorkbook
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Temp"
End With
End Sub
Kindly use this one liner:
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "new_sheet_name"
ThisWorkbook.Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "XYZ"
(when you add a worksheet, anyway it'll be the active sheet)
Try this:
Public Enum iSide
iBefore
iAfter
End Enum
Private Function addSheet(ByRef inWB As Workbook, ByVal inBeforeOrAfter As iSide, ByRef inNamePrefix As String, ByVal inName As String) As Worksheet
On Error GoTo the_dark
Dim wsSheet As Worksheet
Dim bFoundWS As Boolean
bFoundWS = False
If inNamePrefix <> "" Then
Set wsSheet = findWS(inWB, inNamePrefix, bFoundWS)
End If
If inBeforeOrAfter = iAfter Then
If wsSheet Is Nothing Or bFoundWS = False Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = inName
Else
Worksheets.Add(After:=wsSheet).Name = inName
End If
Else
If wsSheet Is Nothing Or bFoundWS = False Then
Worksheets.Add(Before:=Worksheets(1)).Name = inName
Else
Worksheets.Add(Before:=wsSheet).Name = inName
End If
End If
Set addSheet = findWS(inWB, inName, bFoundWS) ' just to confirm it exists and gets it handle
the_light:
Exit Function
the_dark:
MsgBox "addSheet: " & inName & ": " & Err.Description, vbOKOnly, "unexpected error"
Err.Clear
GoTo the_light
End Function
Try to use:
Worksheets.Add (After:=Worksheets(Worksheets.Count)).Name = "MySheet"
If you want to check whether a sheet with the same name already exists, you can create a function:
Function funcCreateList(argCreateList)
For Each Worksheet In ThisWorkbook.Worksheets
If argCreateList = Worksheet.Name Then
Exit Function ' if found - exit function
End If
Next Worksheet
Worksheets.Add (After:=Worksheets(Worksheets.Count)).Name = argCreateList
End Function
When the function is created, you can call it from your main Sub, e.g.:
Sub main
funcCreateList "MySheet"
Exit Sub
Try switching the order of your code. You must create the worksheet first in order to name it.
Private Sub CreateSheet()
Dim ws As Worksheet
Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
ws.Name = "Tempo"
End Sub
thanks,
This will give you the option to:
Overwrite or Preserve a tab that has the same name.
Place the sheet at End of all tabs or Next to the current tab.
Select your New sheet or the Active one.
Call CreateWorksheet("New", False, False, False)
Sub CreateWorksheet(sheetName, preserveOldSheet, isLastSheet, selectActiveSheet)
activeSheetNumber = Sheets(ActiveSheet.Name).Index
If (Evaluate("ISREF('" & sheetName & "'!A1)")) Then 'Does sheet exist?
If (preserveOldSheet) Then
MsgBox ("Can not create sheet " + sheetName + ". This sheet exist.")
Exit Sub
End If
Application.DisplayAlerts = False
Worksheets(sheetName).Delete
End If
If (isLastSheet) Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = sheetName 'Place sheet at the end.
Else 'Place sheet after the active sheet.
Sheets.Add(After:=Sheets(activeSheetNumber)).Name = sheetName
End If
If (selectActiveSheet) Then
Sheets(activeSheetNumber).Activate
End If
End Sub
This is a quick and simple add of a named tab to the current worksheet:
Sheets.Add.Name = "Tempo"