VBA to check if a worksheet exists

jrnyman

Board Regular
Joined
Mar 10, 2002
Messages
105
Does anyone know the code for checking if a worksheet exists. The worksheets name will be the String "NewSht" followed by either the letter "L" or "B". I'm trying to check if the sheet exists, and if it does, overwrite all its cells. If it doesn't, I need to create a new sheet with that name. Thanks for the help.
 
Hello all and thanks for the previous posts on this thread. They were really helpful.

I am working on a master sheet (sheet1) of clients (their first names are written in Column 2). What I want to achieve is have a code that takes each first name, uses it to create a new sheetname, and then copy the row that contains the clients data to his own sheet.

I have written a code that allows the user to input the header row (arow) and the code tests for the last entry (brow). My code works perfectly when it is only the master sheet that exists.

My main challenge is that it doesn't work when say maybe I mistakenly delete one of the client sheets and I then run the code hoping that it will just help me replace the mistakenly deleted one.

Kindly help. Thanks.



Sub Sorter()


'Display dialog box for user to input the row at which the table heading ends
Tableheader.Show


'Use isempty to loop through cells and determine the end of data
Dim Ccount As Long
Ccount = 1
Do
Ccount = Ccount + 1
If IsEmpty(Cells(Ccount, 1)) Then Exit Do
Loop


'Use arow and brow as range of rows that have data
brow = Ccount - 1
arow = Tableheader.HeaderRow


'Display the rows that have data for the user to see and confirm
MsgBox "Table header stops on Row " & arow & vbCrLf & " Data ends on Row " & brow




'Start the loop that creates and sorts the sheets
While arow < brow
arow = arow + 1


'Check if the new sheet name you want to create already exists
Dim wksh As Worksheet, flg As Boolean
For Each wksh In Worksheets
If wksh.Name <> Sheets("Sheet1").Cells(arow, 2) Then flg = True: Exit For
Next wksh

If flg = True Then

Sheets("Sheet1").Select
Rows(arow).Select
Selection.Copy
Sheets.Add.Name = Sheets("Sheet1").Cells(arow, 2)
Rows(3).Select
ActiveSheet.Paste
ActiveSheet.Range("A2:G2").Value = Sheets("Sheet1").Range("A2:G2").Value
Application.CutCopyMode = False

'Else

'MsgBox "A Sheet named " & Sheets("Sheet1").Cells(arow, 2) & " already exists"

End If

Wend


End Sub
 
Upvote 0

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
I have the following code in a workbook to delete 3 worksheets. Problem is, if the sheet doesn't exist I get an error. How do I get it to delete the sheet if it exists and if not, move on?

Application.DisplayAlerts = False
Sheets("Regional Summary").Delete
'Sheets("National Summary (-BBs)").Visible = True
Sheets("National Summary (-BBs)").Delete
Sheets("National Summary (Orig)").Visible = True
Sheets("National Summary (Orig)").Delete
Application.DisplayAlerts = True
 
Upvote 0
here's a VBA snippet that will delete the sheet "Regional Summary" (or as named in the first line of the code) if it exists, and if not then just move on.

You should be easily able to adapt it to do whatever with your other sheet names.
Code:
Sub delete_shhet()

Const todelete As String = "Regional Summary"

Dim sh As Worksheet

With CreateObject("scripting.dictionary")
    For Each sh In ActiveWorkbook.Sheets
        .Item(sh.Name) = True
    Next sh

    If .Item(todelete) = True Then
        Application.DisplayAlerts = False
        Sheets(todelete).Delete
        Application.DisplayAlerts = True
    End If

    'do whatever stuff with other sheet names here

End With

End Sub
 
Upvote 0
Great code, it worked perfectly. There was just a small error in the part which is bold and underlined. It was just a typo

Hey Guys,

I saw this thread and I wanted to show the code I came up with.

I don't like "On Error Resume Next" command so I made the following function:


Code:
Sub Testing()
    Dim SheetName1, SheetName2 As String
    Dim Result As Boolean
    Dim i As Long
    
    
    SheetName = Array("laskgfasdfalskg", "Config")
    
    For i = 0 To UBound(SheetName)
        Result = WorksheetExists(SheetName(i))
        If Result = False Then
            MsgBox "Sheet name " & SheetName(i) & " doesn't exist!"
        Else
            MsgBox "Sheet name " & SheetName(i) & " does exist!"
        End If
    Next i
    
    
End Sub



Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
    
    Dim Sht As Worksheet
        
    WorksheetExists = False
        
    For Each Sht In ActiveWorkbook.Worksheets
        If Sht.Name = WorksheetName Then [B][U]WorksheetExists[/U][/B] = True
    Next Sht
    
End Function
 
Upvote 0
Code could be written
Sub Testing()
SheetName = Array("laskgfasdfalskg", "Sheet4")
For i = 0 To UBound(SheetName)
MsgBox "Sheet name " & SheetName(i) & " does" & IIf(WorksheetExists(SheetName(i)), "", "n't") & " exist"
Next i
End Sub
Function WorksheetExists(ByVal WorksheetName As String) As Boolean
For Each Sht In ActiveWorkbook.Worksheets
If VBA.UCase(Sht.Name) = VBA.UCase(WorksheetName) Then
WorksheetExists = True
Exit Function
End If
Next Sht
End Function
 
Upvote 0
Sub Find_Sheet()
Dim i As Integer
Dim shtname As String
Dim sht As Boolean
sht = False
shtname = InputBox("Enter Sheet Name")
For i = 1 To Sheets.Count
If Worksheets(i).Name = shtname Then
MsgBox "Sheet Available"
sht = True
End If
Next i
If sht = False Then
MsgBox "Sheet Not Available"
End If
End Sub
 
Upvote 0
Hello !

Try this one:

Code:
Option ExplicitSub Testing()
    Dim Result As Boolean
    Dim i As Long
    Dim SheetName As Variant
    SheetName = Array("Sheet1", "Sheet2", "Sheet3")
    
    For i = 0 To UBound(SheetName)
        Result = WorksheetExists(SheetName(i))
         If Result = False Then
            MsgBox "Sheet name " & SheetName(i) & " is missing!", vbCritical, "System message :"
         End If
    Next i
    
End Sub


Function WorksheetExists(ByVal WorksheetName As String) As Boolean
    Dim Sht As Worksheet
   
    For Each Sht In ThisWorkbook.Worksheets
        If Application.Proper(Sht.Name) = Application.Proper(WorksheetName) Then
            WorksheetExists = True
            Exit Function
        End If
    Next Sht
    
    WorksheetExists = False
End Function
 
Upvote 0
Hi, I am struggling...I can't seem to be able to delete this one sheet when looping through all the workbooks in the subdirectory...please, anyone help...

Sub LoopAllExcelFilesInFolder()
'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
'SOURCE: www.TheSpreadsheetGuru.com
Dim wb As Workbook, ws As Worksheet
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim WorksheetName As String
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'Retrieve Target Folder Path From User
Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
With FldrPicker
.Title = "Select A Target Folder"
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
myPath = .SelectedItems(1) & "\"
End With
'In Case of Cancel
NextCode:
myPath = myPath
If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
myExtension = "*.xls"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)

'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook

ActiveWorkbook.CheckCompatibility = False

Set wb = Workbooks.Open(Filename:=myPath & myFile)

Application.DisplayAlerts = False
'Find the excel worksheet 0100_Member_Tracker and delete it

If wb.Worksheets(WorksheetName).Name = "0100_Member_Tracker" Then
wb.Worksheets("0100_Member_Tracker").Delete
Else
End
End If
Application.DisplayAlerts = True

'Save and Close Workbook
MsgBox "Deleted 0100_Member_Tracker"
wb.Close SaveChanges:=True

'Get next file name
myFile = Dir
Loop

'Message Box when tasks are completed
MsgBox "Task Complete!"
ResetSettings:
'Reset Macro Optimization Settings
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,819
Messages
6,121,749
Members
449,050
Latest member
excelknuckles

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top