Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to test Worksheet exists before trying to create it?
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 ----------------------------- |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to test Worksheet exists before trying to create it?
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 ----------------------------- |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to test Worksheet exists before trying to create it?
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to test Worksheet exists before trying to create it?
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 ----------------------------- |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 ----------------------------- |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to test Worksheet exists before trying to create it?
Hi CRayF,
.Tab.ColorIndex = 5 This was an arbitrary value used in test code. --- Regards, Norman "Norman Jones" wrote in message ... 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 ----------------------------- |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
How to test Worksheet exists before trying to create it?
thanks
"Norman Jones" wrote: Hi CRayF, .Tab.ColorIndex = 5 This was an arbitrary value used in test code. --- Regards, Norman "Norman Jones" wrote in message ... 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 ----------------------------- |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Create Worksheet BUT If It Already Exists... | Excel Discussion (Misc queries) | |||
Test for Worksheet Exists | Excel Programming | |||
Test if folder exists, create if it doesn't? | Excel Programming | |||
Test if a folder exists, create if it doesn't? | Excel Programming | |||
Test to see if a worksheet exists thanks, Chip | Excel Programming |