View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Norman Jones Norman Jones is offline
external usenet poster
 
Posts: 5,302
Default 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
-----------------------------