Move data & duplicate current sheet

Hello there and thank you very much for any help received in advance. I have only recently started to learn VBA and have been putting it to practice in creating userforms to help people at my work to be able to timetable more quickly.

I have realised however that in many cases the basic code that I have been using could often be improved. However in the sections below I have not been able to work this out for myself. This needs to be done as after a large number of worksheets exists excel gradually gets slower and slower when running the macros.

Please could anyone help?

Macro 1

Private Sub CommandButton1_Click()
    oldSheet = ActiveSheet.Name
    Sheets("Schedule A GE2").Select
        Range("D5").Select
        ActiveCell.FormulaR1C1 = "='Teacher Class & Room List'!R[-3]C[-3]"
        Range("D6").Select
    Sheets("Schedule B GE2").Select
        Range("D5").Select
        ActiveCell.FormulaR1C1 = "='Teacher Class & Room List'!R[-3]C[-3]"
        Range("D6").Select
    Sheets("Schedule A GE1").Select
        Range("D5").Select
        ActiveCell.FormulaR1C1 = "='Teacher Class & Room List'!R[-3]C[-3]"
        Range("D6").Select
    Sheets("Schedule B GE1").Select
        Range("D5").Select
        ActiveCell.FormulaR1C1 = "='Teacher Class & Room List'!R[-3]C[-3]"
        Range("D6").Select
    Sheets(oldSheet).Activate
End Sub

Macro 2

Private Sub CreateButton_Click()

NewSheet = NameBox.Text
SillyThing = "Name: "
    ActiveSheet.Copy after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = NewSheet
    Range(" A5").Value = SillyThing & NameBox.Text

End Sub

The second of the two macros is the real issue as due to how excel apparently names worksheets the macro will stop working after some time and the only way I have worked out to get it working again is to save and re-open the workbook. It also takes some time to run as I am a complete noob with the dim function.

Many thanks,

Tom

Thanks Rob.

I am creating one sheet at a time, essentially I select the timetable which applies to the student. Select the correct classes using the buttons in the macro and then click "Create" which takes the Name inserted in a NameBox and creates a new sheet with that student's name somewhere on the sheet and with the worksheet's name also being the studen'ts name. There is an intake of between 120-200 students every Monday so that is how many are added to the workbook.

A new workbook is used each Monday however so it does not become too large.

Tom

Edit: Ooopps!
my post was way to slow - I need to type faster ;-)
Anyway, read on...
end edit.

hi Tom,

There is very little need to use select in optimised code, removing .select makes the code run faster & alllows the code to be shortened as well.

Macro 1

option explicit
Private Sub CommandButton1_Click()
dim OriginalSht as worksheet
dim ThisWb as workbook
dim EqtnStr as string

'define variables
set ThisWb = application.activeworkbook
set OriginalSht = ThisWb.ActiveSheet
EqtnStr = "='Teacher Class & Room List'!R[-3]C[-3]"

'enter formulae
with ThisWb
    .Sheets("Schedule A GE2").Range("D5").FormulaR1C1 = eqtnstr
    .Sheets("Schedule B GE2").Range("D5").FormulaR1C1 = eqtnstr
    .Sheets("Schedule A GE1").Range("D5").FormulaR1C1 = eqtnstr
    .Sheets("Schedule B GE1").Range("D5").FormulaR1C1 = eqtnstr
'the following line of code is no longer needed because no other sheet is selected...
'    .OriginalSht.Activate
end with

'free memory
set OriginalSht = nothing
set ThisWb = nothing
End Sub

'Macro 2
Private Sub CreateButton_Click()
    Dim NewShtName As String
    Dim ShtTitle As String
    Application.ScreenUpdating = False
    NewShtName = NameBox.Text
    ShtTitle = "Name: " & NewShtName
    ActiveSheet.Copy after:=Sheets(Sheets.Count)
    With Sheets(Sheets.Count)
        .Name = NewShtName
        .Range(" A5").Value = ShtTitle
    End With
    Application.ScreenUpdating = True
End Sub

I have seen something that explains Excel's approach to creating sheet names & gave a work-around but I can't find it at the moment...
How many sheets are you copying/inserting?


To learn more about macros (eg dim & option explicit), have a read of the links in the section "VBA for Beginners" in the below link:
http://www.excelforum.com/excel-misc...additions.html

hth
Rob

hi Tom,

Wow, that sounds like slow going, to create 120-200 timetables!

I suggest shortening your template sheet name to a single letter eg "z" because there is a limit on the length of sheet names (I think it is 255 characters?) which may cause problems based on the number of sheets being created.

I'm heading out for a while so hopefully someone else can provide more suggestions based on your feedback...

Is any more info added to the file after the individual sheets are created or are they just "one offs" eg for printing?
In other words, is it really neccesary to create a separate sheet for each student?
Or could you change the layout to have all the students' data on a single "database styled sheet" that is looped through to put the relevant info on one copy of the Template, printed out & then onto the next student (using the same sheet)?
(ie separate the input section from the sheet creation section)



hth
Rob

That shouldn't cause a problem, as you can refer to a sheet by it's name.
You do have to be careful though, in that if a sheet name contains spaces then you must enclose the name in single quotes when you refer to it.
Is there any possibility of you uploading a sample workbook, (obviously with fabricated student names)?
That really is the best way to let people see what the problem might be.

So just to clarify;

1) open the workbook
2) On the Autofiller select 'Create/Browse Students'
3) Type a name in the top box, and click create.
4) Repeat step 3 multiple times and the macro should fail?

Yes, though you need to return to one of the 4 timetables before hitting create again. Its not just when trying to create a sheet that alreaddy exists though, it is for any name. I will try to get the error to appear again in just a second. Sorry for the space between responses I am running in and out of the office at the moment.

Edit: Just done as I said above, the exact error I get it as follows:

Run-time error: '1004':

Copy method of worksheet class failed


It always happens after trying to create a worksheet after you have created 11

you can cheek if the sheet exist like this.

Thats if i got the problem correct?

Function SheetExists(NewShtName As String) As Boolean
Dim ws              As Worksheet
    On Error Resume Next
    Set ws = Worksheets(NewShtName)
    If Not ws Is Nothing Then SheetExists = True
End Function
Private Sub CreateButton_Click()
Dim NewShtName      As String
Dim ShtTitle        As String
    Application.ScreenUpdating = False
    NewShtName = NameBox.Text
    
    If SheetExists(NewShtName) Then
    MsgBox "Sheet name aready exist"
    GoTo error
    Else
    ShtTitle = "Name: " & NewShtName
    ActiveSheet.Copy after:=Sheets(Sheets.Count)
    With Sheets(Sheets.Count)
        .Name = NewShtName
        .Range(" A5").Value = ShtTitle
    End With
error:
    Application.ScreenUpdating = True
    End If
End Sub

In that case after creating 12 timesheets still no problem.

Are you sure you don't have a repeated student name? (ie. you are trying to create a timetable for a student name that is the same as one you already have?

Tom, I'd be happy to let you have my email address, but it seems D_Rennie might have it cracked?

Nope afraid not and it is 31 characters in office 97, that is actually to do with the 32-bit coding of the programme. I don't have a problem with naming because each worksheet the maximum number I will reach is around 210 and the names are abbreviated by myself if the student's name is over 31 characters (sometimes they really are that long -.-).

In other words the numbers of each worksheet is still increasing by one not adding an extra ten, hundred, thousand etc to the sheet number but it is something to do with the fact that in VBA excel organises the sheets in a pattern similar to as if they were.

So where x = any other numbers 1xxxxx comes before 2x and 3xxxx before 8xx even though 2x is a smaller numbers than 1xxxxx.

Looking at that Microsoft page I would be tempted to implement the 'WorkAround' rather than the 'Solution' as I think it would better fit your scenario and not impact your macro running time as much.

Yep, Didnt get the problem withen 2007.

Though i see why you have it, Tryed the workaround from the Microsoft Website and its a real pain to have to close it and open each time a record is made.
If i where you ild either upgrade excel, Or Just live with knowing you have to Save,Close,Reopen the worksheet every 7-11 times a sheet is created.

Not sure if it would work though you could try to handle the error.

Private Sub CreateButton_Click()
On Error GoTo ErrorHandle
Dim oBook       As Workbook
    Dim NewShtName  As String
    Dim ShtTitle    As String
    Application.ScreenUpdating = False
    NewShtName = NameBox.Text
    ShtTitle = "Name: " & NewShtName
    ActiveSheet.Copy after:=Sheets(Sheets.Count)
    With Sheets(Sheets.Count)
        .Name = NewShtName
        .Range(" A5").Value = ShtTitle
    End With
    Application.ScreenUpdating = True
Exit Sub
ErrorHandle:
MsgBox "Make Sure That Student Name Dosent Aready Exist" _
& vbNewLine & "Or Close And Reopen the Workbook", vbExclamation, "An Error Has Occured"
End Sub

You may even be able to handle the error with the workaround from the microsoft website. "so it only runs on fail not every time"

Originally Posted by D_Rennie

Though i see why you have it, Tryed the workaround from the Microsoft Website and its a real pain to have to close it and open each time a record is made.
If i where you ild either upgrade excel, Or Just live with knowing you have to Save,Close,Reopen the worksheet every 7-11 times a sheet is created.

That is why I said it might be better to implement the "WORKAROUND" rather than the "RESOLUTION" proposed on that page, as the "WORKAROUND" avoids the repeated saving, closing and opening of the workbook:

RESOLUTION
To resolve this problem, save and close the workbook periodically while the copy...To resolve this problem, save and close the workbook periodically while the copy process is occurring, as in the following sample code:

Sub CopySheetTest()
    Dim iTemp As Integer
    Dim oBook As Workbook
    Dim iCounter As Integer
    
    ' Create a new blank workbook:
    iTemp = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Set oBook = Application.Workbooks.Add
    Application.SheetsInNewWorkbook = iTemp
    
    ' Add a defined name to the workbook
    ' that RefersTo a range:
    oBook.Names.Add Name:="tempRange", _
        RefersTo:="=Sheet1!$A$1"
            
    ' Save the workbook:
    oBook.SaveAs "c:\test2.xls"
    
    ' Copy the sheet in a loop. Eventually,
    ' you get error 1004: Copy Method of
    ' Worksheet class failed.
    For iCounter = 1 To 275
        oBook.Worksheets(1).Copy After:=oBook.Worksheets(1)
        'Uncomment this code for the workaround:
        'Save, close, and reopen after every 100 iterations:
        If iCounter Mod 100 = 0 Then
            oBook.Close SaveChanges:=True
            Set oBook = Nothing
            Set oBook = Application.Workbooks.Open("c:\test2.xls")
        End If
    Next
End Sub

Note The number of times you can copy a worksheet before you must save the workbook varies with the size of the worksheet.

WORKAROUND
To work around this problem, insert a new worksheet from a template instead of copying an existing worksheet. To do this, follow these steps, as appropriate for the version of Excel that you are running.

Microsoft Office Excel 2007
Create a new workbook, and then delete all of the worksheets except for one.
Format the workbook, and then add any text, data, and charts that you must have in the template by default.
Click the Microsoft Office Button, and then click Save As.
In the File name box, type the name that you want for the Excel template.
In the Save as type list, click Template (*.xltx), and then click Save.
To insert the template programmatically, use the following code:

Sheets.Add Type:=path\filename

In this code, path\filename is a string that contains the full path and file name for your sheet template.

Microsoft Office Excel 2003 and earlier versions of Excel
Create a new workbook, and then delete all of the worksheets except for one.
Format the workbook, and then add any text, data, and charts that you must have in the template by default.
Click File, and then click Save As.
In the File name box, type the name that you want for the Excel template.
In the Save as type list, click Template (*.xlt), and then click Save.
To insert the template programmatically, use the following code:

Sheets.Add Type:=path\filename

In this code, path\filename is a string that contains the full path and file name for your sheet template.

double postdouble post