How to test Worksheet exists before trying to create it?
thanks
"Dave Peterson" wrote:
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
on error goto 0
application.displayalerts = true
CRayF wrote:
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 befo=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").ClearConten ts
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
-----------------------------
--
Dave Peterson
|