This question already has answers here:
Test or check if sheet exists
(23 answers)
Closed 8 years ago.
I'm wondering if there is clean cut functionality that returns True or False if a worksheet inside a workbook exists?
It would be good, but not essential, if it's possible to do it without skipping error handling.
The only thing I've found doesn't really work:
On Error Resume Next
If (Worksheets("wsName").Name <> "") Then
Debug.Print "Worksheet exists!"
Else
Debug.Print "Worksheet doesn't exist!"
End If
On Error GoTo ErrHandler
A version without error-handling:
Function sheetExists(sheetToFind As String) As Boolean
sheetExists = False
For Each sheet In Worksheets
If sheetToFind = sheet.name Then
sheetExists = True
Exit Function
End If
Next sheet
End Function
There's no built-in function for this.
Function SheetExists(SheetName As String, Optional wb As Excel.Workbook)
Dim s As Excel.Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set s = wb.Sheets(SheetName)
On Error GoTo 0
SheetExists = Not s Is Nothing
End Function
also a slightly different version. i just did a appllication.sheets.count to know how many worksheets i have additionallyl. well and put a little rename in aswell
Sub insertworksheet()
Dim worksh As Integer
Dim worksheetexists As Boolean
worksh = Application.Sheets.Count
worksheetexists = False
For x = 1 To worksh
If Worksheets(x).Name = "ENTERWROKSHEETNAME" Then
worksheetexists = True
'Debug.Print worksheetexists
Exit For
End If
Next x
If worksheetexists = False Then
Debug.Print "transformed exists"
Worksheets.Add after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "ENTERNAMEUWANTTHENEWONE"
End If
End Sub
Another version of the function without error handling. This time it is not case sensitive and a little bit more efficient.
Function WorksheetExists(wsName As String) As Boolean
Dim ws As Worksheet
Dim ret As Boolean
wsName = UCase(wsName)
For Each ws In ThisWorkbook.Sheets
If UCase(ws.Name) = wsName Then
ret = True
Exit For
End If
Next
WorksheetExists = ret
End Function
Slightly changed to David Murdoch's code for generic library
Function HasByName(cSheetName As String, _
Optional oWorkBook As Excel.Workbook) As Boolean
HasByName = False
Dim wb
If oWorkBook Is Nothing Then
Set oWorkBook = ThisWorkbook
End If
For Each wb In oWorkBook.Worksheets
If wb.Name = cSheetName Then
HasByName = True
Exit Function
End If
Next wb
End Function
Related
This question already has answers here:
Test or check if sheet exists
(23 answers)
Check if sheet exists
(4 answers)
Closed 4 years ago.
I have test many codes which check if a sheet exists (based on name) and if not create one. Some of them loop all sheets and some refer to sheet and if create an error means that sheet does not exist. Which is the most appropriate - orthodox - faster way achieve this task?
Currently I'm using:
Option Explicit
Sub test()
Dim ws As Worksheet
Dim SheetName As String
Dim SheetExists As Boolean
SheetName = "Test"
SheetExists = False
With ThisWorkbook
'Check if the Sheet exists
For Each ws In .Worksheets
If ws.Name = SheetName Then
SheetExists = True
Exit For
End If
Next
If SheetExists = False Then
'If the sheet dont exists, create
.Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = SheetName
End If
End With
End Sub
This is what I use. No need to loop. Directly try to assign to an object. If successful then it means that sheet exists :)
Function DoesSheetExists(sh As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(sh)
On Error GoTo 0
If Not ws Is Nothing Then DoesSheetExists = True
End Function
USAGE
Sub Sample()
Dim s As String: s = "Sheet1"
If DoesSheetExists(s) Then
'
'~~> Do what you want
'
Else
MsgBox "Sheet " & s & " does not exist"
End If
End Sub
Sub solution1()
If Not sheet_exists("sheetnotfound") Then
ThisWorkbook.Sheets.Add( _
After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)).Name = _
"sheetnotfound"
End If
End Sub
Function sheet_exists(strSheetName As String) As Boolean
Dim w As Excel.Worksheet
On Error GoTo eHandle
Set w = ThisWorkbook.Worksheets(strSheetName)
sheet_exists = True
Exit Function
eHandle:
sheet_exists = False
End Function
I wrote a code that is opening a window in which I can select a the excel workbook (#2) I want to copy and import the worksheet from.
The Code is then checking whether the wanted worksheet (named "Guidance") exists in the opened workbook (#2).If so it should be copied and pasted into the current workbook (#1).
After pasting the worksheet the workbook (#2) should be closed again.
So far the code does what I want it to do, as it opens the window and lets me select the wanted worksheet (named "Guidance") but I have the bug (not sure if the translation is correct)
"Runtime error '9': index out of range"
where the worksheet is supposed to be copied and pasted.
Any help on that would be very much appreciated! Thanks in advance.
Private Function SheetExists(sWSName As String, Optional InWorkbook As Workbook) As Boolean
If InWorkbook Is Nothing Then
Set InWorkbook = ThisWorkbook
End If
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(sWSName)
If Not ws Is Nothing Then SheetExists = True
On Error GoTo 0
End Function
Sub GuidanceImportieren()
Dim sImportFile As String, sFile As String
Dim sThisWB As Workbook
Dim vFilename As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sThisWB = ActiveWorkbook
sImportFile = Application.GetOpenFilename("Microsoft Excel Workbooks,
*xls; *xlsx; *xlsm")
If sImportFile = "False" Then
MsgBox ("No File Selected")
Exit Sub
Else
vFilename = Split(sImportFile, "|")
sFile = vFilename(UBound(vFilename))
Application.Workbooks.Open (sImportFile)
Set wbWB = Workbooks("sImportFile")
With wbWB
If SheetExists("Guidance") Then
Set wsSht = .Sheets("Guidance")
wsSht.Copy Before:=sThisWB.Sheets("Guidance")
Else
MsgBox ("No worksheet named Guidance")
End If
wbWB.Close SaveChanges:=False
End With
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
The issue is here
Set wbWB = Worksheets("Guidance") '<-- this should be a workbook not a worksheet?
With wbWB '<-- this with is useless until …
If SheetExists("Guidance") Then
Set wsSht = .Sheets("Guidance") '<-- … until Sheets here starts with a dot
wsSht.Copy Before:=sThisWB.Sheets("Guidance") 'if the error is here then there is no sheet "Guidance" in sThisWB
Else
MsgBox ("No worksheet named Guidance")
End If
wbWB.Close SaveChanges:=False
End With
Also note that SheetExists("Guidance") does not check in a specific workbook (which may fail). I recommend to extend the function to:
Private Function SheetExists(WorksheetName As String, Optional InWorkbook As Workbook) As Boolean
If InWorkbook Is Nothing Then
Set InWorkbook = ThisWorkbook 'fallback if not set
End If
Dim ws As Worksheet
On Error Resume Next
Set ws = InWorkbook.Worksheets(WorksheetName)
SheetExists = Not ws Is Nothing
On Error Goto 0 'necessary because the Err.Number will not be cleared on End Function
End Function
So you can test if a worksheet exists in a specific workbook like
SheetExists("Guidance", sThisWB)
SheetExists("Guidance", wbWB)
Sub GuidanceImportieren()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim sImportFile As String
sImportFile = Application.GetOpenFilename("Microsoft Excel Workbooks, *xls; *xlsx; *xlsm")
If sImportFile = False Then 'false should not be "false"
MsgBox "No File Selected"
Exit Sub
Else
Dim vFilename As Variant
vFilename = Split(sImportFile, "|")
Dim sFile As String
sFile = vFilename(UBound(vFilename))
Dim ImportWorkbook As Workbook
Set ImportWorkbook = Application.Workbooks.Open(sImportFile)
If SheetExists("Guidance", ImportWorkbook) Then
ImportWorkbook.Sheets("Guidance").Copy Before:=ThisWorkbook.Sheets("Guidance")
'you might need to change it into something like this:
Else
MsgBox "No worksheet named Guidance"
End If
ImportWorkbook.Close SaveChanges:=False
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
I have written some VBA code to see if a sheet exists and if it does deletes it and then resumes another module of code. For some reason the code I have below does not do anything and I can't figure out why.
Sub delete()
Dim ws As Worksheet
If worksheetexists("Export Worksheet") Then
Set ws = Worksheets("Export Worksheet")
Application.DisplayAlerts = False
ws.delete
Call GetData
Else
Call GetData
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 = ActiveWorkbook
End If
On Error Resume Next
Set wrksht = wrkbk.Worksheets(sheetname)
worksheetexists = (Err.Number = 0)
Set wrksht = Nothing
On Error GoTo 0
End Function
I updated your code slightly:
Sub delete()
Dim ws As Worksheet
If worksheetexists("Export Worksheet") Then
Set ws = Worksheets("Export Worksheet")
Application.DisplayAlerts = False
ws.delete
Call GetData("pass")
Else
Call GetData("fail")
End If
End Sub
and used this for GetData():
Sub GetData(s)
MsgBox s
End Sub
and it worked perfectly for both the pass and fail cases. Check the spelling of the worksheet name............................especially the number of spaces.
#BriannaCates, the function bellow works for me, maybe works for you.
Public Function deleteWorksheet(sheet As String, Optional work As Workbook) As Boolean
Dim ws As Worksheet
Dim deleted As Boolean
If work Is Nothing Then
Set work = ThisWorkbook
End If
deleted = False
For Each ws In work.Worksheets
If ws.Name = sheet Then
ws.Delete
deleted = True
Exit For
End If
Next
deleteWorksheet = deleted
End Function
I have an existing worksheet "StudentSheet1" which I need to add as many times as a user needs.
For eg, if a user enters 3 in cell "A1", saves it and closes the workbook.
I want to have three sheets: "StudentSheet1" , "StudentSheet2" and "StudentSheet3" when the workbook is opened next time.
So I will have the Code in "Workbook_Open" event. I know how to insert new sheets, but cant insert this particular sheet "StudentSheet1" three times
Here is my code:
Private Sub Workbook_Open()
Application.ScreenUpdating = False
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets.Add(Type:=xlWorksheet, After:=Worksheets(1))
Application.ScreenUpdating = True
End Sub
EDIT
Sorry I misread the question, try this:
Private Sub Workbook_Open()
Dim iLoop As Integer
Dim wbTemp As Workbook
If Not Sheet1.Range("A1").value > 0 Then Exit Sub
Application.ScreenUpdating = False
Set wbTemp = Workbooks.Open(Filename:="//Ndrive/Student/Student.xlsm")
wbTemp.Sheets("StudentSheet1").Copy After:=ThisWorkbook.Sheets(Sheets.Count)
wbTemp.Close
Set wbTemp = Nothing
With Sheet1.Range("A1")
For iLoop = 2 To .Value
Sheets("StudentSheet1").Copy After:=ThisWorkbook.Sheets(Sheets.Count)
ActiveSheet.Name = "StudentSheet" & iLoop
Next iLoop
.Value = 0
End With
Application.ScreenUpdating = True
End Sub
Why are you wanting to add sheets on the workbook open? If the user disables macros then no sheets will be added. As Tony mentioned, why not add the sheets when called by the user?
EDIT
As per #Sidd's comments, if you need to check if the sheet exists first use this function:
Function SheetExists(sName As String) As Boolean
On Error Resume Next
SheetExists = (Sheets(sName).Name = sName)
End Function
user793468, I would recommend a different approach. :)
wbTemp.Sheets("StudentSheet1").Copy After:=ThisWorkbook.Sheets(Sheets.Count)
is not reliable. Please see this link.
EDIT: The above code will fail if the workbook has defined names. Otherwise it is absolutely reliable. Thanks to Reafidy for catching that.
I just noticed OP's comment about the shared drive. Adding amended code to incorporate OP's request.
Tried and Tested
Option Explicit
Const FilePath As String = "//Ndrive/Student/Student.xlsm"
Private Sub Workbook_Open()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim TempName As String, NewName As String
Dim ShtNo As Long, i As Long
On Error GoTo Whoa
Application.ScreenUpdating = False
Set wb1 = ActiveWorkbook
Set ws1 = wb1.Sheets("Sheet1")
ShtNo = ws1.Range("A1")
If Not ShtNo > 0 Then Exit Sub
Set wb2 = Workbooks.Open(FilePath)
Set ws2 = wb2.Sheets("StudentSheet1")
For i = 1 To ShtNo
TempName = ActiveSheet.Name
NewName = "StudentSheet" & i
If Not SheetExists(NewName) Then
ws2.Copy After:=wb1.Sheets(Sheets.Count)
ActiveSheet.Name = NewName
End If
Next i
'~~> I leave this at your discretion.
ws1.Range("A1").ClearContents
LetsContinue:
Application.ScreenUpdating = True
On Error Resume Next
wb2.Close savechanges:=False
Set ws1 = Nothing
Set ws2 = Nothing
Set wb2 = Nothing
Set wb1 = Nothing
On Error GoTo 0
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
'~~> Function to check if sheet exists
Function SheetExists(wst As String) As Boolean
Dim oSheet As Worksheet
On Error Resume Next
Set oSheet = Sheets(wst)
On Error GoTo 0
If Not oSheet Is Nothing Then SheetExists = True
End Function
This question already has answers here:
Test or check if sheet exists
(23 answers)
Closed 4 years ago.
Does anyone know how to check whether certain sheets exist or not in an Excel document using Excel VBA?
Although (unfortunately) such method is not available, we can create our own function to check this..
Hope the code below fits your needs.
Edit1: Added also delete statement...
Sub test()
If CheckSheet(Sheets(3).Name) then
Application.DisplayAlerts = False
Sheets(Sheets(3).Name).Delete
Application.DisplayAlerts = True
End If
End Sub
The solution I'd go for...
Function CheckSheet(ByVal sSheetName As String) As Boolean
Dim oSheet As Excel.Worksheet
Dim bReturn As Boolean
For Each oSheet In ActiveWorkbook.Sheets
If oSheet.Name = sSheetName Then
bReturn = True
Exit For
End If
Next oSheet
CheckSheet = bReturn
End Function
Alternatively, if you don't mind to use code that actively raise errors (which is not recommended by common coding best practices) you could use this 'Spartan Programming wannabe' code below...
Function CheckSheet(ByVal sSheetName As String) As Boolean
Dim oSheet As Excel.Worksheet
Dim bReturn As Boolean
For Each oSheet In ActiveWorkbook.Sheets
If oSheet.Name = sSheetName Then
bReturn = True
Exit For
End If
Next oSheet
CheckSheet = bReturn
End Function
Function CheckSheet(ByVal sSheetName As String) As Boolean
On Error Resume Next
Dim oSheet As Excel.Worksheet
Set oSheet = ActiveWorkbook.Sheets(sSheetName)
CheckSheet = IIf(oSheet Is Nothing, False, True)
End Function
Something like this will get you started:
On Error Resume Next
Dim wSheet as Worksheet
Set wSheet = Sheets(1) ' can also be a string, such as Sheets("Sheet1")
If wSheet Is Nothing Then
MsgBox "Worksheet not found!"
Set wSheet = Nothing ' make the worksheet point to nothing.
On Error GoTo 0
Else
MsgBox "Worksheet found!"
Set wSheet = Nothing ' set the found Worksheet object to nothing. You can use the found wSheet for your purposes, though.
End If
This code was based on http://www.ozgrid.com/VBA/IsWorkbookOpen.htm. Look for the DoesSheetExist() sub.
Hope this helps!
I adapted this code for use in LotusScript, one of the languages used by IBM Notes (formerly Lotus Notes) as shown below.
Public Function ExcelSheetExists( _
xlBook As Variant, _ ' Excel workbook object
ByVal strSheetName As String _
) As Boolean
On Error GoTo errHandler
ForAll xlSheet In xlBook.Sheets
If xlSheet.Name = strSheetName Then
ExcelSheetExists = True
Exit Forall
End If
End ForAll
GoTo Done
errHandler:
' Call MyCustomErrorHandler()
Resume Done
Done:
End Function
On Error GoTo Line1
If Sheets("BOX2").Index > 0 Then
Else
Line1: MsgBox ("BOX2 is missing")
end if
I did it this way:)