How to test Worksheet exists before trying to create it?
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 befo=ActiveSheet
Set NewBettingWs = ActiveSheet
With NewBettingWs
.Name = sStr
.Unprotect
.Tab.ColorIndex = 5
End With
End If
End Sub
---
Regards,
Norman
"CRayF" wrote in message
...
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" wrote:
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
'<<====================
---
Regards,
Norman
"CRayF" wrote in message
...
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
-----------------------------
|