create new sheets based on list of student ID numbers

palaeontology

Active Member
Joined
May 12, 2017
Messages
444
Office Version
  1. 2016
Platform
  1. Windows
Hi, I've watched numerous youtube videos on this topic but can't get my head around it.

I have a list of student ID numbers in .... 'Yr 9 Hw Data'!A4:A36 ... that's a maximum of 33 student ID numbers ... I can't envisage I'd ever have a class of more than 29.

I'd like to have a code that, when a button is pressed, generates a new sheet for any student ID number in the list. Importantly, I have a sheet I'd like to use as a template (for each of these new sheets) called ... 'new sheet template'

I'd need the new sheets to each bear the name of the student number it was generated for.

Obviously, if there are empty cells in the list ... for example if I only have 24 students and there are 9 empty cells at the bottom of the list ..... I wouldn't need a sheet generated for the empty cells.

If the button was pressed a second time, some months later for example, I'd need it to wipe out any existing student ID sheet, and make all new ones from the list.

Is this code possible ?

Kind regards,

Chris
 
Last edited:

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
How about this to create the sheets
Code:
Sub palaeontology()
   Dim Cl As Range
   
   For Each Cl In Sheets("Yr 9 Hw Data").Range("A4:A36")
      If Cl <> "" & Not Evaluate("isref('" & Cl & "'!A1)") Then
         Sheets("new sheet template").Copy , Sheets(Sheets.Count)
         ActiveSheet.Name = Cl.Value
      End If
   Next Cl
End Sub
To delete sheets would it be all sheets with the exception of the template & the sheet with the names?
 
Upvote 0
This script will created all the new sheets.

Now the second part of your request is a little vague

So do you mean when the script runs you want to delete all sheets in the Workbook except for sheet named:

Yr 9 Hw Data
and
new sheet template

If not how will the script know what sheets to delete.

This script makes new sheets for every value in sheet named Yr 9 Hw Data
Starting in Row(4) Column(A) to the last row with data.

Code:
Sub Make_New_Sheets()
'Modified  2/5/2019  7:52:08 AM  EST
On Error GoTo M
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Sheets("Yr 9 Hw Data").Cells(Rows.Count, "A").End(xlUp).Row
For i = 4 To Lastrow
    Sheets("new sheet template").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Sheets("Yr 9 Hw Data").Cells(i, 1).Value
Next
Application.ScreenUpdating = True
Exit Sub
M:
MsgBox "We had a problem here" & vbNewLine & "That may be a bad sheet name or a duplicate sheet name"
End Sub
 
Upvote 0
Thankyou, so much, to both your responses.

I apologise for being vague on that second bit ... yes, when pressing the button a second (or third, or fourth, or fifth, etc ) time, I'd like all sheets deleted except the following three sheets ...

Synergetic Input
Hw Data
new sheet template

Kind regards,

Chris
 
Upvote 0
How about
Code:
Sub palaeontology2()
   Dim Ws As Worksheet
   
   For Each Ws In Worksheets
      Select Case Ws.Name
         Case "Synergetic Input", "Hw Data", "new sheet template"
         Case Else
            Application.DisplayAlerts = False
            Ws.Delete
            Application.DisplayAlerts = True
      End Select
   Next Ws
End Sub
 
Upvote 0
Hi Fluff, this is what I put together from your suggestions ...

Code:
Private Sub CommandButton1_Click()
   Dim Cl As Range
   
   For Each Cl In Sheets("Hw Data").Range("A4:A36")
      If Cl <> "" & Not Evaluate("isref('" & Cl & "'!A1)") Then
         Sheets("new sheet template").Copy , Sheets(Sheets.Count)
         ActiveSheet.Name = Cl.Value
      End If
   Next Cl
Dim Ws As Worksheet
   
   For Each Ws In Worksheets
      Select Case Ws.Name
         Case "Synergetic Input", "Hw Data", "new sheet template"
         Case Else
            Application.DisplayAlerts = False
            Ws.Delete
            Application.DisplayAlerts = True
      End Select
   Next Ws
End Sub

When run the first time, it correctly creates a copy of the template sheet for each student ID in the list ... however, after successfully creating the new sheets it then sends an error message ... Run-time error '13': Type mismatch ... and highlights this line ...

Code:
If Cl <> "" & Not Evaluate("isref('" & Cl & "'!A1)") Then

... as the issue. If I simply press ok, the message goes away and I have the new sheets I desired ... but why is it saying there's an error, if it did the job perfectly ?

Secondly, if the code is run a 2nd time (or a 3rd, 4th, 5th etc) ... which I will need to do from time to time when a new student is added to the list, or if I change the template sheet at all .... it gives the following error message .. Run-time error '1004' That name is already taken. Try a different one. ... and the line ...

Code:
ActiveSheet.Name = Cl.Value

.... is highlighted as the issue. Oddly, it also seems to create an extra sheet I wasn't anticipating ... a copy of the template sheet, but it's calling it .. new sheet template (2) ... I don't need this extra copy.

However, what I'm wanting the code to do (if pressed a second, or third, or fourth etc time) is to delete all sheets (except these three ... Synergetic Input, Hw Data, new sheet template) and re-make new sheets for any student ID in the list ... it's ok for the previous ID sheets to be deleted, no data will be lost, because the template sheet is formulated to bring in data from another source.

How would I need to adjust the code to accommodate the two error messages it's causing ?

Very kind regards,

Chris
 
Upvote 0
I gave a answer to this post before you mentioned what sheets to delete.
And there has been no mention as to my post.

Now I used the Range("A4") to last row in column A with data in case the range was not always the same.
Now that we know what sheets to not delete.

I would think we need to first delete all the sheets in the Workbook except for the three mentioned.
Then we need to make all the new sheets mentioned in the range.

Not the reverse.
 
Upvote 0
As MAIT said the code needs to be the other way round, I've also changed the code to account for the "Type mismatch" error.
Code:
   Dim Cl As Range
   Dim Ws As Worksheet
   
   For Each Ws In Worksheets
      Select Case Ws.Name
         Case "Synergetic Input", "Hw Data", "new sheet template"
         Case Else
            Application.DisplayAlerts = False
            Ws.Delete
            Application.DisplayAlerts = True
      End Select
   Next Ws

   For Each Cl In Sheets("Hw Data").Range("A4:A36")
      If Cl <> "" Then
         If Not Evaluate("isref('" & Cl & "'!A1)") Then
            Sheets("start").Copy , Sheets(Sheets.Count)
            ActiveSheet.Name = Cl.Value
         End If
      End If
   Next Cl
 
Upvote 0
Fluff: Why does your script have this:

Sheets("start").Copy , Sheets(Sheets.Count)

And this:
Case "Synergetic Input", "Hw Data", "new sheet template"

I thought the sheet name to make copies of was:

new sheet template

<strike>
</strike>


As MAIT said the code needs to be the other way round, I've also changed the code to account for the "Type mismatch" error.
Code:
   Dim Cl As Range
   Dim Ws As Worksheet
   
   For Each Ws In Worksheets
      Select Case Ws.Name
         Case "Synergetic Input", "Hw Data", "new sheet template"
         Case Else
            Application.DisplayAlerts = False
            Ws.Delete
            Application.DisplayAlerts = True
      End Select
   Next Ws

   For Each Cl In Sheets("Hw Data").Range("A4:A36")
      If Cl <> "" Then
         If Not Evaluate("isref('" & Cl & "'!A1)") Then
            Sheets("start").Copy , Sheets(Sheets.Count)
            ActiveSheet.Name = Cl.Value
         End If
      End If
   Next Cl
 
Upvote 0
Because i forgot to change it back to the OPs sheet name after testing :(
 
Upvote 0

Forum statistics

Threads
1,214,644
Messages
6,120,709
Members
448,983
Latest member
Joaquim_Baptista

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top