How to test Worksheet exists before trying to create it?

[Guest]

The code below creates the new Worksheet perfectly fine, however, it gets an
error if it tries to add the worksheet if it already exists. Is there a way
to test first to see if this Worksheet exists before trying to create it?

------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim srcProgramDataInputWs As Worksheet
Dim srcProgramSummaryTemplateWs As Worksheet
Dim srcProgramSummaryWs As Worksheet
Dim srcBettingTemplateWs As Worksheet
Dim racePark As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer

Set srcProgramSummaryTemplateWs = Sheets("@TemplateProgramSummary")
Set srcProgramSummaryWs = Sheets("ProgramSummary")
Set srcBettingTemplateWs = Sheets("@TempleteBetting")
Set srcProgramDataInputWs = Sheets("ProgramDataInput")
racePark = Left(srcProgramDataInputWs.Range("H3").Value, 3)

If Target.Address = "$A$1" Then
Dim NewBettingWs As Worksheet
Dim NewBettingWsTabColor As Variant
Dim src As Variant

If racePark = "PHX" Then NewBettingWsTabColor = 10
If racePark = "WHE" Then NewBettingWsTabColor = 46
If racePark = "WON" Then NewBettingWsTabColor = 41

srcBettingTemplateWs.Copy before:=ActiveSheet
Set NewBettingWs = ActiveSheet
With NewBettingWs
.Name = Format(srcProgramDataInputWs. _
Range("F3").Value, "mm-dd-yy ") & _
Left(srcProgramDataInputWs.Range("H3").Value, 3)
.Unprotect
.Tab.ColorIndex = NewBettingWsTabColor 'or replace with index number

src = srcProgramDataInputWs.Range("B3").Value
i = 3
j = 0
Do Until src = ""
srcBettingTemplateWs.Rows("11:22").Copy .Cells((j * 12) + 23, 1)
i = i + 12
j = j + 1
src = srcProgramDataInputWs.Cells(i, 2).Value
Loop

.Protect
End With
End If


If Target.Address = "$K$1" Then
If MsgBox("Are you sure you want to CLEAR this Worksheet?", _
vbYesNo) = vbYes Then
ActiveSheet.Unprotect
ActiveSheet.Range("N3:Q242").Formula =
srcProgramSummaryTemplateWs. _
Range("N3:Q242").Formula
ActiveSheet.Protect
ActiveWorkbook.Save
End If
Range("N3").Select
End If

If Target.Address = "$B$1" Then
Dim SelectedTxtInputFile As Variant
SelectedTxtInputFile = Application.GetOpenFilename( _
"Race Program Input Files (*.txt),*.txt", , _
"Select which RACE Program to import")

If SelectedTxtInputFile = "True" Then
srcProgramDataInputWs.Range("A3:H242").ClearContents

With srcProgramDataInputWs.QueryTables.Add(Connection:= _
"TEXT;" & SelectedTxtInputFile _
, Destination:=srcProgramDataInputWs.Range("A3:H242"))
.Name = "ImportProgramData"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileOtherDelimiter = "|"
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

If MsgBox("Do you want to SAVE Now?", vbYesNo) = vbYes Then
ActiveWorkbook.Save
End If

End If
Range("N3").Select
End If
End Sub
-----------------------------

 

[Norman Jones]

Hi CRayF,

You could test for the existence of the sheet by passing the sheet name to
the following function:

'====================>>
Function SheetExists(sName As String) As Boolean
On Error Resume Next
SheetExists = CBool(Len(Sheets(sName).Name))
On Error GoTo 0
End Function
'<<====================

 

[Dave Peterson]

I like this from Chip Pearson:

Function WorksheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) > 0)
End Function


Then you can use:

if worksheetexists("sheet1", activeworkbook) then
'do something
else
'do something else
end if

========
On the other hand, you could just delete the existing worksheet:

application.displayalerts = false
on error resume next
worksheets("sheet99").delete

 

[Guest]

I'm trying to test for the Worksheet name but is was created using an in
stream calculation.

.Name = Format(srcProgramDataInputWs. _
Range("F3").Value, "mm-dd-yy ") & _
Left(srcProgramDataInputWs.Range("H3").Value, 3)

I tried adding a:
Dim NewBettingWsName As Worksheet

then changed the above to:
NewBettingWsName = Format(srcProgramDataInputWs. _
Range("F3").Value, "mm-dd-yy ") & _
Left(srcProgramDataInputWs.Range("H3").Value, 3)

.Name = NewBettingWsName

In order for me to use "NewBettingWsName" in my test for the function
provided but I get an error on the "NewBettingWsName =" line.
Also, where does a Function go? Do I place this inside the routine or
somewhere special?

 

[Norman Jones]

HiCRayF,

I'm trying to test for the Worksheet name but is was created using an in
stream calculation.

The following demonstrates a different approach:

Sub Tester()
Dim NewBettingWs As Worksheet
Dim sStr As String

sStr = Format(srcProgramDataInputWs. _
Range("F3").Value, "mm-dd-yy ") & _
Left(srcProgramDataInputWs.Range("H3").Value, 3)

On Error Resume Next 'In case the sheet already exists!
Set NewBettingWs = Sheets(sStr)
On Error GoTo 0

If Not ws Is Nothing Then
'Sheet already exists - What do you want to do?!
Else
'Sheet not found, so go ahead and create it
srcBettingTemplateWs.Copy before:=ActiveSheet
Set NewBettingWs = ActiveSheet
With NewBettingWs
.Name = sStr
.Unprotect
.Tab.ColorIndex = 5
End With
End If

End Sub

 

[Norman Jones]

Hi CRayF,

.Tab.ColorIndex = 5

This was an arbitrary value used in test code.

 

[Guest]

thanks

I like this from Chip Pearson:

Function WorksheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) > 0)
End Function


Then you can use:

if worksheetexists("sheet1", activeworkbook) then
'do something
else
'do something else
end if

========
On the other hand, you could just delete the existing worksheet:

application.displayalerts = false
on error resume next
worksheets("sheet99").delete

 

[Guest]

thanks

Hi CRayF,

.Tab.ColorIndex = 5

This was an arbitrary value used in test code.