"Default" values when adding new sheet

[Zahhhaaaa]

Hello again,

Is this possible?? I have 3 data validation lists on a worksheet, each of them include some data, weather measurements, working times, workers, etc. And user can select what he wants. Then, I wanna add new sheet and these data validation lists should appear on this new sheet, but in their default mode, or how should I say it...

Here's an example;

DROP DOWN LIST 1 ---Sunny, Cloudy, Rain, Snow
DROP DOWN LIST 2 ---Worker1, Worker2, Worker3
DROP DOWN LIST 3 ---Blaah1, Blaah2, Blaah3


I also use this code to add more rows;

Sub insertrow()
With Rows(6)
   .Copy
   .Insert 'the copy will be put in the newl;y created row
End With
Application.CutCopyMode = False
End Sub

Let's say I add 1 more row, so it looks like this;

DROP DOWN LIST 1 ---Sunny, Cloudy, Rain, Snow
DROP DOWN LIST 1 ---Sunny, Cloudy, Rain, Snow

DROP DOWN LIST 2 ---Worker1, Worker2, Worker3
DROP DOWN LIST 2 ---Worker1, Worker2, Worker3

DROP DOWN LIST 3 ---Blaah1, Blaah2, Blaah3
DROP DOWN LIST 3 ---Blaah1, Blaah3, Blaah2

I change them like this;

DROP DOWN LIST 1 ---Snow, Cloudy, Rain, Sunny
DROP DOWN LIST 1 ---Snow, Cloudy, Sunny, Rain

DROP DOWN LIST 2 ---Worker3, Worker1, Worker2
DROP DOWN LIST 2 ---Worker2, Worker3, Worker1

DROP DOWN LIST 3 ---Blaah3, Blaah2, Blaah1
DROP DOWN LIST 3 ---Blaah3, Blaah1, Blaah2

(between these, I "save" this file before adding new sheet, but that's no problem)
Then I add new sheet using code;

Sub NewSheet()
Dim CurrentDay As Integer, NewName As String
If IsNumeric(Right(ActiveSheet.Name, 2)) Then
   CurrentDay = Right(ActiveSheet.Name, 2)
ElseIf IsNumeric(Right(ActiveSheet.Name, 1)) Then
   CurrentDay = Right(ActiveSheet.Name, 1)
Else
   Exit Sub
End If
CurrentDay = CurrentDay + 1
NewName = Format(Date, "dd.mm.yyyy")
Dim checkWs As Worksheet
On Error Resume Next
Set checkWs = Worksheets(NewName)
If checkWs Is Nothing Then
   Worksheets(ActiveSheet.Name).Copy After:=Worksheets(ActiveSheet.Index)
  Dim oleObj As OLEObject
With ActiveSheet
   .Name = NewName
   .Range("D2").ClearContents
   .Range("D6").ClearContents
   .Range("A31").ClearContents
   .Range("B31").ClearContents
   .Range("C31").ClearContents
   .Range("D31").ClearContents
   .Range("A34:B37").ClearContents
   .Range("C34:D37").ClearContents
   .Range("A40:B43").ClearContents
   .Range("C40:D43").ClearContents
   .Range("A46").ClearContents
   .Range("B46").ClearContents
   .Range("C46").ClearContents
   .Range("D46").ClearContents
   For Each oleObj In ActiveSheet.OLEObjects
      If oleObj.progID = "Forms.TextBox.1" Then oleObj.Object.Value = ""
   Next oleObj
   Dim Shp As Shape
 For Each Shp In ActiveSheet.Shapes
   If Shp.Type = msoTextBox Then
     Shp.TextFrame.Characters.Text = ""
   End If
 Next Shp
End With
 
Else
   Set checkWs = Nothing
   MsgBox "Uusi taulukko voidaan lisätä huomenna."
End If
End Sub

And drop down lists are back to their default mode, like this;

DROP DOWN LIST 1 ---Sunny, Cloudy, Rain, Snow
DROP DOWN LIST 2 ---Worker1, Worker2, Worker3
DROP DOWN LIST 3 ---Blaah1, Blaah2, Blaah3


Is this possible??

 

[John Davis]

Why not create a Default Sheet with the original Drop Down List in the Default Order and maybe create you're new sheets with something like this?

With Sheets("Default")
    Cells.Copy
    Sheets.Add
    Cells.Select
    ActiveSheet.Paste
End With

 

[VoG]

Or just

Sheets("Default").Copy after:=Worksheets(Worksheets.Count)

 

[Zahhhaaaa]

Exactly, where in the code should I add these if I wanna test them? Sorry but I'm a rookie and don't know but hey I'm honest to myself =) learning while talking

 

[VoG]

Instead of your existing code, create a sheet that is your template, name it Default then use

Sub NewSheet()
Sheets("Default").Copy after:=Worksheets(Worksheets.Count)
End Sub

 

[Zahhhaaaa]

Oh.. ok.. But sheet needs to be named by specific date, I'm making a diary and I can't change it anymore 'cuz then I'll have to start everything all over again.

This is the code I'm using, that opens a new sheet and names it as specific date, like today "7.20.2011".

(That's why I asked is it possible to add some code into this)

Sub NewSheet()
Dim CurrentDay As Integer, NewName As String
If IsNumeric(Right(ActiveSheet.Name, 2)) Then
    CurrentDay = Right(ActiveSheet.Name, 2)
ElseIf IsNumeric(Right(ActiveSheet.Name, 1)) Then
    CurrentDay = Right(ActiveSheet.Name, 1)
Else
    Exit Sub
End If
CurrentDay = CurrentDay + 1
NewName = Format(Date, "dd.mm.yyyy")
Dim checkWs As Worksheet
On Error Resume Next
Set checkWs = Worksheets(NewName)
If checkWs Is Nothing Then
    Worksheets(ActiveSheet.Name).Copy After:=Worksheets(ActiveSheet.Index)
   Dim oleObj As OLEObject
With ActiveSheet
    .Name = NewName
    .Range("D2").ClearContents
    .Range("D6").ClearContents
    .Range("A31").ClearContents
    .Range("B31").ClearContents
    .Range("C31").ClearContents
    .Range("D31").ClearContents
    .Range("A34:B37").ClearContents
    .Range("C34:D37").ClearContents
    .Range("A40:B43").ClearContents
    .Range("C40:D43").ClearContents
    .Range("A46").ClearContents
    .Range("B46").ClearContents
    .Range("C46").ClearContents
    .Range("D46").ClearContents
    For Each oleObj In ActiveSheet.OLEObjects
       If oleObj.progID = "Forms.TextBox.1" Then oleObj.Object.Value = ""
    Next oleObj
    Dim Shp As Shape
  For Each Shp In ActiveSheet.Shapes
    If Shp.Type = msoTextBox Then
      Shp.TextFrame.Characters.Text = ""
    End If
  Next Shp
End With
 
Else
    Set checkWs = Nothing
    MsgBox "Uusi taulukko voidaan lisätä huomenna."
End If
End Sub

But if it comes a problem, then I'll have to leave it like it is right now

 

[VoG]

Try this

Sub NewSheet()
Sheets("Default").Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = Format(Date, "dd.mm.yyyy")
End Sub

 

[Zahhhaaaa]

Hmmm... I renamed sheet "Default", it does open a new sheet with a specific date as a name, but it doesn't do anything else :P

 

[VoG]

You need to set up the Default sheet exactly as you want it. Then use the code to make copies as required.

 

[Zahhhaaaa]

Now I figured it out, thanks again!