Find worksheet

[jnf40]

Hi all,

I have a workbook that will add worksheets and name the worksheet depending
on the buttons clicked by the user and the date entered by the user. The
worksheet names will be something like "01-01-06 CSB 18" RCP" if the same
date is used the next worksheet will be "01-01-06 CSB 18" RCP (2)" and so on.
If the user changes the date to "01/02/06" then the next worksheet name would
be
"01-02-06 CSB 18" RCP" and so on. The problem I have is that if I then go
back to the date "01/01/06" I get "Run-time error '1004': Cannot rename a
sheet to the same name as another sheet, a referenced object library or a
workbook referenced by Visual Basic."
Is there a way to have it check for this and then add the new worksheet and
it's name would then be
"01-01-06 CSB 18" RCP (3)" and place it in between "01-01-06 CSB 18" RCP
(2)" and "01-02-06 CSB 18" RCP"?

 

[Dave Peterson]

First, I would add the sheet whereever I wanted and then just sort the sheets
after I'm done.

Chip Pearson has some code at:
http://www.cpearson.com/excel/sortws.htm
that you can use.

But this kind of routine can be used to add another sheet:

Option Explicit
Sub testme()

Dim mySFX As String
Dim myPFX As String
Dim wks As Worksheet
Dim iCtr As Long
Dim myStr As String

'01-01-06 CSB 18" RCP

mySFX = " CSB 18"" RCP"
myPFX = Trim(InputBox(prompt:="Enter date: mm-dd-yy"))

If Len(myPFX) <> 8 Then
Beep
MsgBox "Try again later!"
Exit Sub
End If

Set wks = Worksheets.Add(after:=Worksheets(Worksheets.Count))
iCtr = 0
Do
If iCtr = 0 Then
myStr = ""
Else
myStr = " (" & iCtr & ")"
End If
On Error Resume Next
wks.Name = myPFX & mySFX & myStr
If Err.Number <> 0 Then
Err.Clear
Else
Exit Do
End If
On Error GoTo 0
iCtr = iCtr + 1
Loop

Call SortTheSheets

End Sub
Sub SortTheSheets()
'put Chip Pearson's code here
End Sub

 

[jnf40]

Dave,

I tried your code in a new workbook and it worked fine for adding sheets,
the problem is I have a sheet set up and hidden and when they click a button
it makes this worksheet visible, copies it at the end of the other worksheets
then hides the original again and renames the copy, the date comes from a
cell on sheet1. When I included your code, I made some changes and it would
rename it but it wouldn't set the iCtr, it skipped it every time and made a
worksheet with a duplicate name, i.e: "01-01-06 CSB 18" RCP"; "01-01-06 CSB
18" RCP (2)";
"01-02-06 CSB 18" RCP"; "01-01-06 CSB 18" RCP". Then it would sort the
sheets and I ended up with "01-01-06 CSB 18" RCP"; "01-01-06 CSB 18" RCP";
"01-01-06 CSB 18" RCP (2)"; "01-02-06 CSB 18" RCP". I have included my
original code, but can't figure how to include your code to make it work.

Sub Macro1()
Dim myMonth As Integer
Dim myYear As Integer
Dim mytestdate As Date
Dim Q As Integer
Dim MySelect As Excel.Name
Dim WhatsWrong As String
Dim MyTempHold As Integer
Dim mytday As Integer
Dim myFileName As String
Dim XS As Integer

Dim blnCorrect As Boolean
blnCorrect = True
ActiveWorkbook.Unprotect Password:="csb"

Application.ScreenUpdating = False
Sheets("Create Pay Report").Visible = False
strMMs = "Create Pay Report"
If Excel.Range("SH") = "S" Then
mydate = Range("date")
strMM = Format(mydate, "mm-dd-yy")
Range("date2") = Range("date")
Range("date3") = Range("date")
Range("date3") = Format(mydate, "mm-dd")
If Range("date") > "" Then FirstSheet = strMM
Sheets("CSB Form 1257").Visible = True
Sheets("CSB Form 1257").Select
Sheets("CSB Form 1257").Copy After:=Sheets(Sheets.Count)
Sheets("CSB Form 1257").Visible = False
Sheets("CSB Form 1257 (2)").Select
ActiveSheet.Unprotect Password:="csb"

Range("BB62") = Sheets(Sheets.Count - 1).Range("BB62") + 1
ActiveSheet.Range("date1") = Range("date")
If ActiveSheet.Range("date1") = Sheets(Sheets.Count - 1).Range("date1")
Then
ActiveSheet.Range("SameDateNumber") = Sheets(Sheets.Count -
1).Range("SameDateNumber") + 1
Sheets("CSB Form 1257 (2)").Name = strMM & " " & "CSB" & " " &
Range("EighteentoEightyfour") & """" & " " & "RCP" & " " & "(" &
ActiveSheet.Range("SameDateNumber") & ")"
Else: Sheets("CSB Form 1257 (2)").Name = strMM & " " & "CSB" & " " &
Range("EighteentoEightyfour") & """" & " " & "RCP"
End If


"I have code here to format certain cells in the new sheet."


strMMs = strMM
ActiveSheet.Protect Password:="csb", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
UserInterfaceOnly:=True

ActiveWorkbook.Protect Password:="csb"
ActiveWorkbook.Save
End Sub

 

[Dave Peterson]

I tried reading the code, but it depends (a lot!) on what the active worksheet
is. I find that this kind of code very difficult to understand and maintain. I
like to add object variables that represents each of the worksheets that I'm
gonna use.

I have no idea how much damage I did to your code, but it might help you later
to do this now.

Option Explicit
Sub Macro1()
Dim myMonth As Long
Dim myYear As Long
Dim mytestdate As Date
Dim Q As Long
Dim MySelect As Name
Dim WhatsWrong As String
Dim MyTempHold As Long
Dim myTday As Long
Dim myFileName As String
Dim XS As Long

Dim PayRptWks As Worksheet
Dim CSBForm1257 As Worksheet
Dim NewWks As Worksheet
Dim ActWks As Worksheet
Dim NextToLastWks As Worksheet

Dim strMM As String
Dim myDate As String
Dim FirstSheet As String

Dim blnCorrect As Boolean
blnCorrect = True
ActiveWorkbook.Unprotect Password:="csb"

Application.ScreenUpdating = False

Set PayRptWks = Sheets("Create Pay Report")
Set CSBForm1257 = Sheets("CSB Form 1257")
Set ActWks = ActiveSheet

PayRptWks.Visible = False

With ActWks
If .Range("SH") = "S" Then
myDate = .Range("date")
strMM = Format(myDate, "mm-dd-yy")
.Range("date2") = .Range("date")
.Range("date3") = .Range("date")
.Range("date3") = Format(myDate, "mm-dd")
If .Range("date") > "" Then
FirstSheet = strMM
End If
With CSBForm1257
.Visible = True
.Copy _
After:=Sheets(Sheets.Count)
Set NewWks = ActiveSheet
'maybe this goes here or later???
NewWks.Name = GiveItANiceName(strMM, NewWks)
.Visible = False
End With

Set NextToLastWks = Sheets(Sheets.Count - 1)
With NewWks
.Unprotect Password:="csb"
.Range("BB62") = NextToLastWks.Range("BB62") + 1
.Range("date1") = Range("date")
If .Range("date1") = NextToLastWks.Range("date1") Then
'determine the prefix here
else
'if the prefix could change
end if
NewWks.Name = GiveItANiceName(strMM, NewWks)
'that subroutine will do the numbering itself--don't worry
'about it!
End With
End If
End With


NewWks.Protect Password:="csb", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
UserInterfaceOnly:=True

ActiveWorkbook.Protect Password:="csb"
ActiveWorkbook.Save
End Sub

Sub GiveItANiceName(myPFX As String, wks As Worksheet)

Dim iCtr As Long
Dim mySFX As String
Dim myStr As String
Do
If iCtr = 0 Then
myStr = ""
Else
myStr = " (" & iCtr & ")"
End If
On Error Resume Next
wks.Name = myPFX & mySFX & myStr
If Err.Number <> 0 Then
Err.Clear
Else
Exit Do
End If
On Error GoTo 0
iCtr = iCtr + 1
Loop
End Sub

You'll notice one more subrouting "GiveItANiceName".

You pass it the prefix that it should use and it'll figure out what to put in
the ()'s.

I could test that little subroutine with this test procedure:

Sub testme()

Dim strMM As String
Dim NewWks As Worksheet
strMM = "01-01-06 CSB 18"" RCP"

Set NewWks = Worksheets.Add
Call GiveItANiceName(strMM, NewWks)

End Sub

It'll be up to you to pass it the correct prefix.

=========
"01-01-06 CSB 18" RCP"
"01-01-06 CSB 18" RCP"
"01-01-06 CSB 18" RCP (2)"
"01-02-06 CSB 18" RCP"

Was the way things ended after you sorted? Except for the duplicate name (typo
in post???), it looks like it's in the correct order to me.

 

[jnf40]

Dave,
Thanks for the response and tips on object variables. A couple problems to
start. In your code you have 'NewWks.Name = GiveItANiceName(strMM, NewWks)' I
get a Compile Error Expected Function or Variable. and it will not call the
Sub GiveItANiceName. I also tried to add 'Call GiveItANiceName' and I got a
Compile Error Argument Not Optional. Any suggestions. Thanks

 

[Dave Peterson]

Make sure you include the bottommost subroutine. (I think you missed it.)

And it expects you to pass two things--the prefix of the name (a string
variable) and the worksheet (a worksheet variable) to rename.

 

[jnf40]

Are you talking about the sub testme()?

Make sure you include the bottommost subroutine. (I think you missed it.)

And it expects you to pass two things--the prefix of the name (a string
variable) and the worksheet (a worksheet variable) to rename.

 

[Dave Peterson]

nope. This one:


Sub GiveItANiceName(myPFX As String, wks As Worksheet)

Dim iCtr As Long
Dim mySFX As String
Dim myStr As String
Do
If iCtr = 0 Then
myStr = ""
Else
myStr = " (" & iCtr & ")"
End If
On Error Resume Next
wks.Name = myPFX & mySFX & myStr
If Err.Number <> 0 Then
Err.Clear
Else
Exit Do
End If
On Error GoTo 0
iCtr = iCtr + 1
Loop
End Sub

 

[jnf40]

Is there a way I could email you the workbook the way it was before I tried
adding your code and you take a look at it?

 

[Dave Peterson]

I don't open other workbooks.

Maybe you can try explaining again or someone else will accept your offer.

 

[jnf40]

The following code is what I have now and when it goes to Sub Macro1() it
gives me the Compile Error Expected Function or Variable, and GiveItANiceName
is highlighted, and it will not call the Sub GiveItANiceName(). I have the
Sub GiveItANiceName() immediately follwing the Sub Macro1(). Maybe it is the
way I am doing the prefix during the If Else, I don't know. Your help is
greatly appreciated.

Sub Macro1()
Dim myMonth As Long
Dim myYear As Long
Dim mytestdate As Date
Dim Q As Long
Dim MySelect As Name
Dim WhatsWrong As String
Dim MyTempHold As Long
Dim myTday As Long
Dim myFileName As String
Dim XS As Long

Dim PayRptWks As Worksheet
Dim CSBForm1257 As Worksheet
Dim NewWks As Worksheet
Dim ActWks As Worksheet
Dim NextToLastWks As Worksheet

Dim strMM As String
Dim myDate As String
Dim FirstSheet As String

Dim blnCorrect As Boolean
blnCorrect = True
ActiveWorkbook.Unprotect Password:="csb"

Application.ScreenUpdating = False

Set PayRptWks = Sheets("Create Pay Report")
Set CSBForm1257 = Sheets("CSB Form 1257")
Set ActWks = ActiveSheet


With ActWks
If .Range("SH") = "S" Then
myDate = .Range("date")
strMM = Format(myDate, "mm-dd-yy")
.Range("date2") = .Range("date")
.Range("date3") = .Range("date")
.Range("date3") = Format(myDate, "mm-dd")
If .Range("date") > "" Then
FirstSheet = strMM
End If
PayRptWks.Visible = False
With CSBForm1257
.Visible = True
.Copy _
After:=Sheets(Sheets.Count)
Set NewWks = ActiveSheet
'maybe this goes here or later???
NewWks.Name = GiveItANiceName(strMM, NewWks)
.Visible = False
End With

Set NextToLastWks = Sheets(Sheets.Count - 1)
With NewWks
.Unprotect Password:="csb"
.Range("BB62") = NextToLastWks.Range("BB62") + 1
.Range("date1") = Range("date")
If .Range("date1") = NextToLastWks.Range("date1") Then
strMM = Format(myDate, "mm-dd-yy")
'determine the prefix here
Else
strMM = Format(myDate, "mm-dd-yy")
'if the prefix could change
End If
NewWks.Name = GiveItANiceName(strMM, NewWks)
'that subroutine will do the numbering itself--don't worry
'about it!
End With
End If
End With


NewWks.Protect Password:="csb", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
UserInterfaceOnly:=True

ActiveWorkbook.Protect Password:="csb"
ActiveWorkbook.Save
End Sub

Sub GiveItANiceName(myPFX As String, wks As Worksheet)

Dim iCtr As Long
Dim mySFX As String
Dim myStr As String
myPFX = strMM
mySFX = " CSB" & Range("EighteentoEightyfour") & """" & " " & "RCP"
Do
If iCtr = 0 Then
myStr = ""
Else
myStr = " (" & iCtr & ")"
End If
On Error Resume Next
wks.Name = myPFX & mySFX & myStr
If Err.Number <> 0 Then
Err.Clear
Else
Exit Do
End If
On Error GoTo 0
iCtr = iCtr + 1
Loop
End Sub

 

[Dave Peterson]

I'm sorry. I had a change of heart when I was writing that code.

I changed it from a function to a subroutine. So you'll have to change this
line:

NewWks.Name = GiveItANiceName(strMM, NewWks)
to
Call GiveItANiceName(strMM, NewWks)

Sorry, again.