Creating a dynamic Worksheet name?

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Variables available in a worksheet:
LEFT(ProgramDataInput!H3,3) returns a 3 char name (or PHX)
ProgramDataInput!F3 hold a date in the format mm/dd/yyyy (or
09/21/05)

In the code below, instead of a fixed "NewWS" name, I'd like to create it
with a name the worksheet "mm-dd-yy rrr"
Example would be "09-21-05 PHX"
How do do the same "LEFT(ProgramDataInput!H3,3)" in a macro and how would I
substring out "09-21" out of "09/21/05" to use below?

If Target.Address = "$A$1" Then
Dim NewNewWS As Worksheet
Set NewNewWS = Worksheets.Add
With NewNewWS
.Name = "NewWS"
End With
End If
 
If Target.Address = "$A$1" Then
Dim NewNewWS As Worksheet
Set NewNewWS = Worksheets.Add
With NewNewWS
.Name = Format(ProgramDataInput!F3,"mm-dd-yy ") & _
LEFT(ProgramDataInput!H3,3)
End With
End If
 
The code below runs fine with the line:
.Name = "NewBettingWS"

I'm getting a Runtime Error whe I change it with:
.Name = Format(ProgramDataInput!F3, "mm-dd-yy ") & _
Left(ProgramDataInput!H3, 3)

It says Runtime Error '424' Object Required
Cell ProgramDataInput!F3 has "9/14/2005"
Cell ProgramDataInput!H3 has "PHX PHOENIX"

any clues?
----------------
If Target.Address = "$A$1" Then
Dim NewBettingWS As Worksheet
Set NewBettingWS = Worksheets.Add
With NewBettingWS
.Name = Format(ProgramDataInput!F3, "mm-dd-yy ") & _
Left(ProgramDataInput!H3, 3)
ActiveSheet.Unprotect
ActiveSheet.Range("A1:AB10").Formula =
Sheets(BettingTemplateSource).Range("A1:AB10").Formula
ActiveSheet.Protect
ActiveWorkbook.Save
End With
End If
------------------
 
Try:

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

Hope this helps
Rowan
 
Perfect that worked... thanks a million
Now, any chance you have an answer for this thread:
"Copping cells EXACTLY from one Worksheet to a new Worksheet? " (misspelled)
I am now trying to copy contents into this new worksheet from a template.
It’s not coping the formatting...
 
Is there a way to have the newly created Worksheet be placed on the tab just
to the left of the Worksheer that ran the Macro? And is there a way to create
the new Worksheet to have a TAB color?
 
If Target.Address = "$A$1" Then
Dim NewNewWS As Worksheet
Set NewNewWS = Worksheets.Add(Before:=Me)
With NewNewWS
.Name = Format(ProgramDataInput!F3, "mm-dd-yy ") & _
Left(ProgramDataInput!H3, 3)
.Name = Format(Sheets("ProgramDataInput"). _
Range("F3").Value, "mm-dd-yy ") & _
Left(Sheets("ProgramDataInput").Range("H3").Value, 3)
End With
End If
 
thanks
This is what I ended up with...
I'm now stuggling with adding the last bit of code to bypass the creating of
the new WOrksheet if it alreay exists....
thanks again for your help...
-----------------
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

Range("N3").Select

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
----------------
 
A bit of generic code to check that a sheet exists.

Sub shtexists()
Dim exists As Boolean
Dim sht As Worksheet
exists = false
For Each sht In ThisWorkbook.Sheets
If sht.Name = "MySheet" Then
exists = True
Exit For
End If
Next
If exists Then
MsgBox "Sheet exists"
Else
MsgBox "No sheet by that name"
End If
End Sub

Regards
Rowan
 
This was perfect. Here is the complete code after I added in your code for
testing if the Worksheet exists before trying to create it. Thanks a million!

BTW… How is an If this then that Else If this then that… coded in VBS?
Once one of the below will be true… Would that not be more efficient then
the way I coded this?

In my code below:
If racePark = "PHX" Then NewBettingWsTabColor = 10
If racePark = "WHE" Then NewBettingWsTabColor = 46
If racePark = "WON" Then NewBettingWsTabColor = 41

Thanks again.

------------------------
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 exists As Boolean
Dim ExistingBettingWsName As Worksheet
Dim NewBettingWsName As Variant

Range("N3").Select

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

exists = False
For Each ExistingBettingWsName In ThisWorkbook.Sheets
If ExistingBettingWsName.Name = NewBettingWsName Then
exists = True
Exit For
End If
Next
If exists Then
MsgBox "Betting Worksheet for [ " & NewBettingWsName & _
" ] already exists. [RENAME] or [DELETE] that Worksheet and try
again."

Else
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

Range("N3").Select

srcBettingTemplateWs.Copy before:=ActiveSheet
Set NewBettingWs = ActiveSheet
With NewBettingWs
.Name = NewBettingWsName
.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
End If

End Sub
----------------------------
 
Your welcome.

Two ways you could do the if:

If racePark = "PHX" Then
newBettingWsTabColor = 10
ElseIf racePark = "WHE" Then
newBettingWsTabColor = 46
ElseIf racePark = "WON" Then
newBettingWsTabColor = 41
Else
newBettingWsTabColor = 1 'default
End If

or

Select Case racePark
Case "PHX"
newBettingWsTabColor = 10
Case "WHE"
newBettingWsTabColor = 46
Case "WON"
newBettingWsTabColor = 41
Case Else
newBettingWsTabColor = 1 'default
End Select

In both cases the else portion of the statement is optional.

Regards
Rowan
This was perfect. Here is the complete code after I added in your code for
testing if the Worksheet exists before trying to create it. Thanks a million!

BTW… How is an If this then that Else If this then that… coded in VBS?
Once one of the below will be true… Would that not be more efficient then
the way I coded this?

In my code below:
If racePark = "PHX" Then NewBettingWsTabColor = 10
If racePark = "WHE" Then NewBettingWsTabColor = 46
If racePark = "WON" Then NewBettingWsTabColor = 41

Thanks again.

------------------------
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 exists As Boolean
Dim ExistingBettingWsName As Worksheet
Dim NewBettingWsName As Variant

Range("N3").Select

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

exists = False
For Each ExistingBettingWsName In ThisWorkbook.Sheets
If ExistingBettingWsName.Name = NewBettingWsName Then
exists = True
Exit For
End If
Next
If exists Then
MsgBox "Betting Worksheet for [ " & NewBettingWsName & _
" ] already exists. [RENAME] or [DELETE] that Worksheet and try
again."

Else
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

Range("N3").Select

srcBettingTemplateWs.Copy before:=ActiveSheet
Set NewBettingWs = ActiveSheet
With NewBettingWs
.Name = NewBettingWsName
.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
End If

End Sub
----------------------------
Click to expand...
 
PS did you see my repsonse in "Copping cells EXACTLY from one Worksheet
to a new Worksheet?" regarding the extra set of rows copied and changing
the line:
srcBettingTemplateWs.Rows("11:22").Copy .Cells((j * 12) + 23, 1)
to
srcBettingTemplateWs.Rows("11:22").Copy .Cells((j * 12) + 11, 1)

Regards
Rowan
This was perfect. Here is the complete code after I added in your code for
testing if the Worksheet exists before trying to create it. Thanks a million!

BTW… How is an If this then that Else If this then that… coded in VBS?
Once one of the below will be true… Would that not be more efficient then
the way I coded this?

In my code below:
If racePark = "PHX" Then NewBettingWsTabColor = 10
If racePark = "WHE" Then NewBettingWsTabColor = 46
If racePark = "WON" Then NewBettingWsTabColor = 41

Thanks again.

------------------------
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 exists As Boolean
Dim ExistingBettingWsName As Worksheet
Dim NewBettingWsName As Variant

Range("N3").Select

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

exists = False
For Each ExistingBettingWsName In ThisWorkbook.Sheets
If ExistingBettingWsName.Name = NewBettingWsName Then
exists = True
Exit For
End If
Next
If exists Then
MsgBox "Betting Worksheet for [ " & NewBettingWsName & _
" ] already exists. [RENAME] or [DELETE] that Worksheet and try
again."

Else
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

Range("N3").Select

srcBettingTemplateWs.Copy before:=ActiveSheet
Set NewBettingWs = ActiveSheet
With NewBettingWs
.Name = NewBettingWsName
.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
End If

End Sub
----------------------------
Click to expand...
 
A better routine to check if a sheet exists IMO in that it doesn't loop
through them all

'-----------------------------------------------------------------
Function SheetExists(Sh As String, _
Optional wb As Workbook) As Boolean
'-----------------------------------------------------------------
Dim oWs As Worksheet
If wb Is Nothing Then Set wb = ActiveWorkbook
On Error Resume Next
SheetExists = CBool(Not wb.Worksheets(Sh) Is Nothing)
On Error GoTo 0
End Function
 
Back
Top