Macro that can switch between tabs

[rcorona106]

Hey OssieMac,

Your help to Jorge has helped me a lot with something I'm working on. If
you can, I'd love your help with one problem I'm having. Here's the code of
my macro:

Sheets(newShtName).Select
Range("L8:L48").Select
Selection.Replace What:="oldShtName", Replacement:="newShtName",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

What I'm trying to do is to go the new sheet and change the formula in cells
L8 through L48 by replacing the old sheet's name with the new sheet's name.
The above didn't work. How do I make it work? Thanks in advance for your
help.

Hi Again Jorge,

This has become war and peace.

Protecting the new sheet.
Before you do anything with the following code, I advise making a backup of
your workbook in case of problems.

Your question about identifying and matching the locked and unlocked cells
in the new sheet intrigued me enough to research it. Below is yet another
version of code for you. You still have to insert your code into it and I
have put a comment in uppercase where I think it should go.

You also have to edit the range A1:K40 to match the range that you are using
on your spreadsheets. Don’t try to use the entire spreadsheet range or you
will be waiting until the New Year for the procedure to run. Simply include a
range large enough to cover all the data on your sheet. Doesn’t matter if it
is larger but can’t be smaller.

I am assuming that you know that protecting the sheet is a 2 step procedure.
Firstly step is to unlock cells that the user will be allowed to edit and
second step is to protect the sheet using a password.

The code identifies the unlocked cells on the original sheet and unlocks the
corresponding cells on the new sheet. It then protects the new sheet with a
password and then re-protects the original sheet with the password.

My thoughts are that the old sheet should be totally protected to prevent
users making retro changes to it. If you would like to be able to do this, I
have included a line of code that you can uncomment to do it. However read
and heed the comment in upper case because once you run it with this line,
all cells on the original will be locked and you will not be able to use it
as a sample to create a new sheet with the specific unlocked cells. You will
need to manually unlock the editing cells again if you still need to make
further adjustments to the code etc to get everything right. Note that the
USER WITH THE PASSWORD will still be able to make changes to the old sheet if
required and it doesn’t matter whether the cells are locked or unlocked once
it is unprotected with the password.

I am going away for a week to ten days from Tuesday so if you need any final
tweaking then I need to know about it by early Monday or it waits until I get
home again.

Sub Insert_New_Sheet()

Dim oldShtName As String
Dim newShtName As String
Dim wSht As Object
Dim cellAddress As String
Dim workRnge As Range
Dim c1 As Range

oldShtName = ActiveSheet.Name

'Create string variable from date in
'Active Sheet cell K3 + 14 days
newShtName = Format(ActiveSheet.Range("K3") _
+ 14, "d-mm-yyyy")

'Test that new sheet name not previously created.
For Each wSht In Sheets
If LCase(wSht.Name) = LCase(newShtName) Then
MsgBox "Worksheet " & newShtName & _
" already exists." & Chr(13) & _
"Processing terminated"
End
End If
Next wSht

'Unprotect so that button will copy
'Replace OssieMac with your password.
Sheets(oldShtName).Unprotect ("OssieMac")

'If cell K3 in the old sheet is to be updated
'with the + 14 days then take the single quote _
'off the following line. (See comment at end also.)

'Sheets(oldShtName).Range("K3") = ActiveSheet.Range("K3") + 14

'Following line adds sheet as first sheet
Sheets.Add Before:=Sheets(1)

'Following line adds sheet before active sheet
'Sheets.Add Before:=Sheets(oldShtName)

'Following line adds sheet after active sheet
'Sheets.Add After:=Sheets(oldShtName)

'Following line adds sheet after last sheet
'Sheets.Add After:=Sheets(Sheets.Count)

ActiveSheet.Name = newShtName
Sheets(oldShtName).Cells.Copy
Sheets(newShtName).Paste

Sheets(oldShtName).Range("B34").Copy
Sheets(newShtName).Select
Range("B21").Select
ActiveSheet.Paste Link:=True

Application.CutCopyMode = False

'If you updated the date in cell K3
'in the original sheet above with the +14
'then it will have been copied with the update
'to the new sheet. However, if you did not
'include it above but want it updated in the
'new sheet then remove the single quote from _
'the following line.

'Sheets(newShtName).Range("K3") = _
Sheets(newShtName).Range("K3") + 14

'INSERT YOUR CODE HERE.

'All the following code should be last code in
'procedure.
'Unlock cells on new sheet to match the unlocked
'cells in the original sheet. (ie. Cells that
'the user is allowed to edit.

'Edit code "A1:K40" in next line to match the
'working range on YOUR original sheet.
Set workRnge = Sheets(oldShtName).Range("A1:K40")
For Each c1 In workRnge
If c1.Locked = False Then
cellAddress = c1.Address
Sheets(newShtName).Range(cellAddress) _
.Locked = False
End If
Next c1

'Protect the new sheet
'Replace OssieMac with your password
Sheets(newShtName).Protect Password:="OssieMac", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True

'Reprotect the original sheet.
'Replace OssieMac with your password.

'Uncomment the following line of code if you
'want to prevent retro changes to the old
'sheet by anyone without the password.
'DO NOT UNCOMMENT THIS LINE UNTIL YOU HAVE
'TOTALLY FINISHED TESTING THE PROCEDURE AND
'EVEN THEN, MAKE SURE THAT YOU HAVE A BACKUP
'OF THE WORKBOOK.

'Sheets(oldShtName).Cells.Locked = True

Sheets(oldShtName).Protect Password:="OssieMac", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True

End Sub

Regards,

OssieMac

The only way that I know of copying the button is to unprotect the sheet,
copy it and then protect it again. Another version of the code below to show
you how to do it.

With the code you posted for protecting all worksheets I think that it still
requires you to unlock the cells that users are allowed to alter before
applying the protection. This will also apply to the newly created worksheet
and your best way is to record the unlocking. You don't have to do this to
the original again just because you unprotect it because unprotection does
not remove the unlocked info.

Sub Insert_New_Sheet()
Dim oldShtName As String
Dim newShtName As String
Dim wSht As Object

oldShtName = ActiveSheet.Name

'Unprotect so that button will copy
'Replace OssieMac with your password.
Sheets(oldShtName).Unprotect ("OssieMac")

'Create string variable from date in
'Active Sheet cell K3 + 14 days
newShtName = Format(ActiveSheet.Range("K3") _
+ 14, "d-mm-yyyy")

'Test that new sheet name not previously created.
For Each wSht In Sheets
If LCase(wSht.Name) = LCase(newShtName) Then
MsgBox "Worksheet " & newShtName & _
" already exists." & Chr(13) & _
"Processing terminated"
End
End If
Next wSht

'If cell K3 in the old sheet is to be updated
'with the + 14 days then take the single quote _
'off the following line. (See comment at end also.)
'Sheets(oldShtName).Range("K3") = ActiveSheet.Range("K3") + 14

'Following line adds sheet as first sheet
Sheets.Add Before:=Sheets(1)

'Following line adds sheet before active sheet
'Sheets.Add Before:=Sheets(oldShtName)

'Following line adds sheet after active sheet
'Sheets.Add After:=Sheets(oldShtName)

'Following line adds sheet after last sheet
'Sheets.Add After:=Sheets(Sheets.Count)

ActiveSheet.Name = newShtName
Sheets(oldShtName).Cells.Copy
Sheets(newShtName).Paste

Sheets(oldShtName).Range("B34").Copy
Sheets(newShtName).Select
Range("B21").Select
ActiveSheet.Paste Link:=True

Application.CutCopyMode = False

'If you updated the date in cell K3
'in the original sheet above with the +14
'then it will have been copied with the update
'to the new sheet. However, if you did not
'include it above but want it updated in the
'new sheet then remove the single quote from _
'the following line.
'Sheets(newShtName).Range("K3") = _
Sheets(newShtName).Range("K3") + 14

Range("A1").Select

'Reprotect the original sheet
'Replace OssieMac with your password
Sheets(oldShtName).Protect Password:="OssieMac", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True


End Sub

Regards,

OssieMac

Hi OssieMac,

I created a button to assign the macro as away of passing it on to other
users. However, what I noticed was that I needed to select unlooked (in
format control) so that the button would be copied over to the new sheet.

Is there any way of leaving the button locked so that it can not be deleted
yet still be available on the new sheet?

Regards
Jorge

:

Hi OssieMac,

To improve your perspective, I'm working with are staff time sheets. As you
would have worked out, the idea is to have multiple time sheets in the one
workbook rather than opening a new workbook for each time sheet.

As such all the sheets are identical in format but obviously the hours
worked etc are going to be different. This means that the last [active] sheet
is effectively the master sheet, ie the sheet upon which the new sheet will
be based. Hope I'm being clear enough.

Yes I agree that there is no longer the need for user input concerning the
sheet name and you are also correct regarding the date format, though would
you make it d-mm-yyyy.

On a more personal note (if you don't mind) you know where I'm from, where
to you hail from and is the "Mac" bit to do with your actual name or the fact
that you use Apple Macs?

Regards
Jorge


:

 

[Don Guillett]

Don't know why you needed sheetname in the formula but here you go. No
selections and no looking. Fire from anywhere in the workbook.

Sub changesheetnameinformula()
Sheets("sheet2").Range("L8:L48").Replace "sheet1", "sheet2"
End Sub


--
Don Guillett
Microsoft MVP Excel
SalesAid Software
(e-mail address removed)

Hey OssieMac,

Your help to Jorge has helped me a lot with something I'm working on. If
you can, I'd love your help with one problem I'm having. Here's the code
of
my macro:

Sheets(newShtName).Select
Range("L8:L48").Select
Selection.Replace What:="oldShtName", Replacement:="newShtName",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

What I'm trying to do is to go the new sheet and change the formula in
cells
L8 through L48 by replacing the old sheet's name with the new sheet's
name.
The above didn't work. How do I make it work? Thanks in advance for your
help.

Hi Again Jorge,

This has become war and peace.

Protecting the new sheet.
Before you do anything with the following code, I advise making a backup
of
your workbook in case of problems.

Your question about identifying and matching the locked and unlocked
cells
in the new sheet intrigued me enough to research it. Below is yet another
version of code for you. You still have to insert your code into it and I
have put a comment in uppercase where I think it should go.

You also have to edit the range A1:K40 to match the range that you are
using
on your spreadsheets. Don’t try to use the entire spreadsheet range or
you
will be waiting until the New Year for the procedure to run. Simply
include a
range large enough to cover all the data on your sheet. Doesn’t matter if
it
is larger but can’t be smaller.

I am assuming that you know that protecting the sheet is a 2 step
procedure.
Firstly step is to unlock cells that the user will be allowed to edit and
second step is to protect the sheet using a password.

The code identifies the unlocked cells on the original sheet and unlocks
the
corresponding cells on the new sheet. It then protects the new sheet with
a
password and then re-protects the original sheet with the password.

My thoughts are that the old sheet should be totally protected to prevent
users making retro changes to it. If you would like to be able to do
this, I
have included a line of code that you can uncomment to do it. However
read
and heed the comment in upper case because once you run it with this
line,
all cells on the original will be locked and you will not be able to use
it
as a sample to create a new sheet with the specific unlocked cells. You
will
need to manually unlock the editing cells again if you still need to make
further adjustments to the code etc to get everything right. Note that
the
USER WITH THE PASSWORD will still be able to make changes to the old
sheet if
required and it doesn’t matter whether the cells are locked or unlocked
once
it is unprotected with the password.

I am going away for a week to ten days from Tuesday so if you need any
final
tweaking then I need to know about it by early Monday or it waits until I
get
home again.

Sub Insert_New_Sheet()

Dim oldShtName As String
Dim newShtName As String
Dim wSht As Object
Dim cellAddress As String
Dim workRnge As Range
Dim c1 As Range

oldShtName = ActiveSheet.Name

'Create string variable from date in
'Active Sheet cell K3 + 14 days
newShtName = Format(ActiveSheet.Range("K3") _
+ 14, "d-mm-yyyy")

'Test that new sheet name not previously created.
For Each wSht In Sheets
If LCase(wSht.Name) = LCase(newShtName) Then
MsgBox "Worksheet " & newShtName & _
" already exists." & Chr(13) & _
"Processing terminated"
End
End If
Next wSht

'Unprotect so that button will copy
'Replace OssieMac with your password.
Sheets(oldShtName).Unprotect ("OssieMac")

'If cell K3 in the old sheet is to be updated
'with the + 14 days then take the single quote _
'off the following line. (See comment at end also.)

'Sheets(oldShtName).Range("K3") = ActiveSheet.Range("K3") + 14

'Following line adds sheet as first sheet
Sheets.Add Before:=Sheets(1)

'Following line adds sheet before active sheet
'Sheets.Add Before:=Sheets(oldShtName)

'Following line adds sheet after active sheet
'Sheets.Add After:=Sheets(oldShtName)

'Following line adds sheet after last sheet
'Sheets.Add After:=Sheets(Sheets.Count)

ActiveSheet.Name = newShtName
Sheets(oldShtName).Cells.Copy
Sheets(newShtName).Paste

Sheets(oldShtName).Range("B34").Copy
Sheets(newShtName).Select
Range("B21").Select
ActiveSheet.Paste Link:=True

Application.CutCopyMode = False

'If you updated the date in cell K3
'in the original sheet above with the +14
'then it will have been copied with the update
'to the new sheet. However, if you did not
'include it above but want it updated in the
'new sheet then remove the single quote from _
'the following line.

'Sheets(newShtName).Range("K3") = _
Sheets(newShtName).Range("K3") + 14

'INSERT YOUR CODE HERE.

'All the following code should be last code in
'procedure.
'Unlock cells on new sheet to match the unlocked
'cells in the original sheet. (ie. Cells that
'the user is allowed to edit.

'Edit code "A1:K40" in next line to match the
'working range on YOUR original sheet.
Set workRnge = Sheets(oldShtName).Range("A1:K40")
For Each c1 In workRnge
If c1.Locked = False Then
cellAddress = c1.Address
Sheets(newShtName).Range(cellAddress) _
.Locked = False
End If
Next c1

'Protect the new sheet
'Replace OssieMac with your password
Sheets(newShtName).Protect Password:="OssieMac", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True

'Reprotect the original sheet.
'Replace OssieMac with your password.

'Uncomment the following line of code if you
'want to prevent retro changes to the old
'sheet by anyone without the password.
'DO NOT UNCOMMENT THIS LINE UNTIL YOU HAVE
'TOTALLY FINISHED TESTING THE PROCEDURE AND
'EVEN THEN, MAKE SURE THAT YOU HAVE A BACKUP
'OF THE WORKBOOK.

'Sheets(oldShtName).Cells.Locked = True

Sheets(oldShtName).Protect Password:="OssieMac", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True

End Sub

Regards,

OssieMac

The only way that I know of copying the button is to unprotect the
sheet,
copy it and then protect it again. Another version of the code below to
show
you how to do it.

With the code you posted for protecting all worksheets I think that it
still
requires you to unlock the cells that users are allowed to alter before
applying the protection. This will also apply to the newly created
worksheet
and your best way is to record the unlocking. You don't have to do this
to
the original again just because you unprotect it because unprotection
does
not remove the unlocked info.

Sub Insert_New_Sheet()
Dim oldShtName As String
Dim newShtName As String
Dim wSht As Object

oldShtName = ActiveSheet.Name

'Unprotect so that button will copy
'Replace OssieMac with your password.
Sheets(oldShtName).Unprotect ("OssieMac")

'Create string variable from date in
'Active Sheet cell K3 + 14 days
newShtName = Format(ActiveSheet.Range("K3") _
+ 14, "d-mm-yyyy")

'Test that new sheet name not previously created.
For Each wSht In Sheets
If LCase(wSht.Name) = LCase(newShtName) Then
MsgBox "Worksheet " & newShtName & _
" already exists." & Chr(13) & _
"Processing terminated"
End
End If
Next wSht

'If cell K3 in the old sheet is to be updated
'with the + 14 days then take the single quote _
'off the following line. (See comment at end also.)
'Sheets(oldShtName).Range("K3") = ActiveSheet.Range("K3") + 14

'Following line adds sheet as first sheet
Sheets.Add Before:=Sheets(1)

'Following line adds sheet before active sheet
'Sheets.Add Before:=Sheets(oldShtName)

'Following line adds sheet after active sheet
'Sheets.Add After:=Sheets(oldShtName)

'Following line adds sheet after last sheet
'Sheets.Add After:=Sheets(Sheets.Count)

ActiveSheet.Name = newShtName
Sheets(oldShtName).Cells.Copy
Sheets(newShtName).Paste

Sheets(oldShtName).Range("B34").Copy
Sheets(newShtName).Select
Range("B21").Select
ActiveSheet.Paste Link:=True

Application.CutCopyMode = False

'If you updated the date in cell K3
'in the original sheet above with the +14
'then it will have been copied with the update
'to the new sheet. However, if you did not
'include it above but want it updated in the
'new sheet then remove the single quote from _
'the following line.
'Sheets(newShtName).Range("K3") = _
Sheets(newShtName).Range("K3") + 14

Range("A1").Select

'Reprotect the original sheet
'Replace OssieMac with your password
Sheets(oldShtName).Protect Password:="OssieMac", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True


End Sub

Regards,

OssieMac



:

Hi OssieMac,

I created a button to assign the macro as away of passing it on to
other
users. However, what I noticed was that I needed to select unlooked
(in
format control) so that the button would be copied over to the new
sheet.

Is there any way of leaving the button locked so that it can not be
deleted
yet still be available on the new sheet?

Regards
Jorge

:

Hi OssieMac,

To improve your perspective, I'm working with are staff time
sheets. As you
would have worked out, the idea is to have multiple time sheets in
the one
workbook rather than opening a new workbook for each time sheet.

As such all the sheets are identical in format but obviously the
hours
worked etc are going to be different. This means that the last
[active] sheet
is effectively the master sheet, ie the sheet upon which the new
sheet will
be based. Hope I'm being clear enough.

Yes I agree that there is no longer the need for user input
concerning the
sheet name and you are also correct regarding the date format,
though would
you make it d-mm-yyyy.

On a more personal note (if you don't mind) you know where I'm
from, where
to you hail from and is the "Mac" bit to do with your actual name
or the fact
that you use Apple Macs?

Regards
Jorge


:

 

[rcorona106]

Here's the entire macro:
Sub Insert_New_Sheet()
Dim oldShtName As String
Dim newShtName As String
Dim wSht As Object
Dim wShtExists As Boolean
Dim inputPrompt As String

oldShtName = ActiveSheet.Name

inputPrompt = "Enter name for new sheet or Cancel to exit."

Do
wShtExists = False
Beep
newShtName = InputBox(prompt:=inputPrompt, _
Title:="New Sheet Name")

'Next few lines of code required in case user Cancels
'or user only enters only spaces in the input box.
'or user enters nothing and clicks on OK.
If Len(Trim(newShtName)) = 0 Then
Beep
MsgBox "Invalid entry or user Cancelled." _
& Chr(13) & Chr(13) & "New worksheet not created."
End
End If

For Each wSht In Sheets
If LCase(wSht.Name) = LCase(newShtName) Then
wShtExists = True
inputPrompt = _
"Worksheet name already exists. Enter new name"
End If
Next wSht
Loop While wShtExists = True

'Following line adds sheet as first sheet
Sheets.Add Before:=Sheets(1)

ActiveSheet.Name = newShtName
Sheets(oldShtName).Cells.Copy
Sheets(newShtName).Paste


' This goes to current month's sheet and hard codes the current month's
activity

Sheets(oldShtName).Select
Range("J8:J14").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("J18:J36").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("J40:J45").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

' This will update YTD total and clear recently ended month's total on the
data sheet

Sheets("MB Report").Select
Range("D1142").Select
Selection.Copy
Range("H11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("E11:E42").Select
Application.CutCopyMode = False
Selection.ClearContents

' This updates the YTD total on the new monthly sheet


Sheets(newShtName).Select

Range("L8:L48").Select
Selection.Replace What:="oldShtName", Replacement:="newShtName",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub

Maybe with the entire programming, my problem will make sense.

 

[Don Guillett]

You may like this approach better. Fires from the active sheet.

Sub InsertNewSheetDON()
Dim oldsht As String
Dim newname As String
Dim s As Worksheet

oldsht = ActiveSheet.Name
newname = InputBox("name sheet")
For Each s In Sheets
'checks for sht
If s.Name = newname Then
MsgBox "Pick Another Name and try again"
Exit Sub

Else
'copies activesht
ActiveSheet.Copy before:=Sheets(1)
ActiveSheet.Name = newname

With Sheets(oldsht)
'could probably be "j8:j45"??
.Range("j8:j14,j18:j36,j40:j45").Value = _
.Range("j8:j14,j28:j36,j40:j45").Value
End With

With Sheets("MB Report")
.Range("h11:h42").Value = .Range("D1142").Value
.Range("E11:E42").ClearContents
End With

Exit For
End If
Next s
End Sub

 

[rcorona106]

I replaced my macro with yours but it created another problem and did not
address what I was trying to get done with the last section of my macro. The
new problem is that the macro goes to the old sheet and zeroes out the cells
in column J. I need it to change the formulas to values not zeroes.

The problem your macro doesn't address is going to the new sheet and
updating the formula which references the old sheet. In other words, in
column L of the old sheet I have the formula +j11+'oldersht'!L11 where
oldersht is an older sheet. I want the macro to update the formula to be
+j11+'oldsht'!L11. So it should change the formula to reference the newly
created old sheet.

Does this make sense?

 

[Don Guillett]

If you like, send your file to my address below along with snippets of these
msgs and exactly what you want, along with before/after examples.

 

[Don Guillett]

New one
Sub InsertNewSheetDON()
Dim oldsht As String
Dim newname As String
Dim s As Worksheet
Application.ScreenUpdating = False
oldsht = ActiveSheet.Name
newname = InputBox("name sheet")
For Each s In Sheets
'checks for sht
If s.Name = newname Then
MsgBox "Pick Another Name and try again"
Exit Sub

Else
'copies activesht
ActiveSheet.Copy before:=Sheets(1)
ActiveSheet.Name = newname

With Sheets(oldsht) 'changes to values
.Range("j8:j45").Value = .Range("j8:j45").Value
.Shapes("Rectangle 1").Cut
End With

With ActiveSheet 'fix formula to reflect last month
chgto = Sheets(.Index + 1).Name
chgfrom = Sheets(.Index + 2).Name
.Range("L8:L45").Replace chgfrom, chgto

'does as of on cell a3
asn = ActiveSheet.Name
nd = DateSerial(Right(asn, 2), Left(asn, 2), Mid(asn, 3, 2))
..Range("a3") = "As of " & Format(nd, "mmmm dd, yyyy")
End With

With Sheets("MB Report") 'fixes mbreport
.Range("h11:h42").Value = .Range("D1142").Value
.Range("E11:E42").ClearContents
End With

Exit For
End If
Next s
Application.ScreenUpdating = True
End Sub