Macro

  • Thread starter Thread starter Steve
  • Start date Start date
S

Steve

Following is my macro that copies a hidden sheet
(extended reservation) and renames the sheet as the value
in cell C4 on Create Reservation sheet. If C4 is an
existing sheet name the macro returns an error and the new
sheet is named extended reseervatiom(2). I would like, if
there is a duplicate for extended reservation(2) not to be
created. Also how do I assign short cutkey.

Sorry so long and Thanks!!!
'
' create Macro
' Macro recorded 8/21/2003 by zz535a1
'
'

Sheets("EXTENDED RESERVATION").Visible = True
Sheets("EXTENDED RESERVATION").Copy After:=Sheets(2)
Range("C1:C7").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Range("B9:B104").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlFormulas,
Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Locked = True
Selection.FormulaHidden = False
ActiveSheet.Protect DrawingObjects:=True,
Contents:=True, Scenarios:=True
Sheets("EXTENDED RESERVATION").Select
ActiveWindow.SelectedSheets.Visible = False

Call Worksheet_Change


End Sub

Private Sub Worksheet_Change()
Dim sName As String

sName = CStr(Sheets("CREATE RESERVATION").Range
("C4").Formula)
Sheets("EXTENDED RESERVATION (2)").Name = sName

End Sub
 
You can check to see if a sheetname already exists with a little code like this:

dim testWks as worksheet
set testWks = nothing
on error resume next
set testwks = worksheets("extended reservation (2)")
on error goto 0
if testWks is nothing then
'it doesn't exist, do what you have to (unhide/copy/hide, etc)
else
'it already exists, skip what you need to skip.
end if


And you can assign a shortcut key to a macro by:

Alt-F8 (tools|macro|macros...)
click on your macro to select it
click on options
assign your shortcut key combination
click ok (to save your work)
click cancel to leave the macro dialog
 
One way:

Public Sub CreateExtendedReservation()
Dim wkSht As Worksheet
Dim myName As String

Application.ScreenUpdating = False
myName = Worksheets("CREATE RESERVATION").Range("C4").Text
On Error Resume Next
Set wkSht = Worksheets(myName)
On Error GoTo 0
If wkSht Is Nothing Then
With Worksheets("EXTENDED RESERVATION")
.Visible = True
.Copy After:=Sheets(2)
.Visible = False
End With
With ActiveSheet
.Name = myName
With .Range("C1:C7")
.Value = .Value
End With
With .Range("B9:B104")
.Value = .Value
.Locked = True
.FormulaHidden = False
End With
.Protect DrawingObjects:=True, _
Contents:=True, Scenarios:=True
End With
End If
Application.ScreenUpdating = True
End Sub
 
It worked! Now can I add a pop up of some sort that says
some thing like please enter a unique number?
 
You can create an input box as follows:

Sub box()
Dim DouNumber As Double

DouNumber = InputBox("please enter a unique number")

End Sub

Good Luck

Moshe
 
What error are you getting? The macro I posted doesn't attempt to
create a new sheet if there's an existing sheet named with what's in
C4.

Please give an example of what C4 contains when you get the error.
 
It works thanks
-----Original Message-----
What error are you getting? The macro I posted doesn't attempt to
create a new sheet if there's an existing sheet named with what's in
C4.

Please give an example of what C4 contains when you get the error.


.
Click to expand...
 
It worked! Now can I add a pop up of some sort that says
some thing like please enter a unique number?
Click to expand...

User-hostile. Computers are much better than humans at generating identifiers
that don't already appear in some list. If these identifiers are numbers, then

=MAX(LIST)+1

would *always* be unique, and vastly simpler and faster for Excel to determine
than it would be for your users (unless you have some savants on payroll).
 
Back
Top