Creating new sheet

[The_Steward]

Hey,

I need some help figures out solutions to the problems below. I have created a basic macro using the recorder but it is limited in helping me solve these problems.

Problem Description:

1.
I need to create a commandbutton that allows users to add new clients to the workbook.

But to do this properly they need to add a new sheet and then automatically rename the sheet to the next value in the column.

i.e if had a list which goes client1, client2, client3 etc, then I need the button to perform an operation that creates a new sheet, and renames it to client1, then when clicked again adds a new sheet and renames it client2 and so forth.

I also need setting and data from a template sheet automatically copy + pasted so that each new sheet is set up the same way.

End solution should automatically have a cell selected (i.e "E5") in this new sheet so users can start entering data.

2.
This leads to my 2nd problem, updating the workbook.
Now there may be a point where someone adds up to a 100 clients or more, and then I need to update their workbook. it would be too time consuming and tedious to edit all these sheets, so I need a commandbutton that links to a macro that loops through all the sheets that have a matching name within my column of client1, client2, client3 etc and updates all these sheets to exactly match the template sheet. (Please note: i'm not worried about data being overidden as I am working on a solution for this that allows users to automatically have their saved data uploaded into each sheet they've created when it's updated)

Any help or suggestions are much appreciated.

 

[The_Steward]

Also in the second code, you should change this:

ws = Sheets("Sheet").Range("R4:R" & lRow).Value

to this:

workSheets = Sheets("Sheet").Range("R4:R" & lRow).Value

Sorry, it is very early in the morning here. Still trying to waking up

Yeah the second one not working for me even with these changes. the following coming up as mismatch.

 lRow = Worksheets("Code and Data Centre").Cells(Rows.Count, 1).End(xlUp).Row

 

[The_Steward]

I didn't understand your question. Are you going to rename using a naming scheme?
Basically it will go like this:

Sub myFunction()
  Dim ws As Worksheet
  Dim lRow As Integer
  lRow = Worksheets("Code and Data Centre").Cells(Rows.Count, 18).End(xlUp).Row
  For Each ws In Worksheets
    If ws.Name <> "Participant1" And ws.Name <> "Code and Data Centre" Then 'Put a condition if you want to exclude any
      For i = 4 to lRow
        If ws.Name = Worksheets("Code and Data Centre").Cells(i, 18).Value Then
          'Do anything here if any worksheet name matches any name in the list.
        End If
      Next
    End If
  Next
End Sub

Sorry, it wasn't very clear.

I meant that instead of creating a button that users click to create new sheet, I would instead just create all the sheets for them and rename them in one macro.

But of course in case I stuff something up it would be great to have separate macro to delete all these sheets I just created and start again.

Hope that makes sense. My brain is also fried after long day so I might being going bonkers.

 

[Legacy 143009]

Yeah the second one not working for me even with these changes. the following coming up as mismatch.

Yes, that should be also column 18.

 lRow = Worksheets("Code and Data Centre").Cells(Rows.Count, 18).End(xlUp).Row

 

[Legacy 143009]

I meant that instead of creating a button that users click to create new sheet, I would instead just create all the sheets for them and rename them in one macro.

I think the first routine is already doing this.

If you going the use a different naming scheme, you must define your own rules. I am sharing more simplified version of the first code with the same method that I used in the second code:

Sub createNewWorksheet()
  Dim lRow As Integer
  Dim ws As Worksheet
  Dim sheetNames As Variant

  lRow = Worksheets("Code and Data Centre").Cells(Rows.Count, 18).End(xlUp).Row
  sheetNames = Worksheets("Code and Data Centre").Range("R4:R" & lRow).Value

  For Each wsName In sheetNames
    Sheets("Participant Template").Copy After:=Sheets(Sheets.Count)
    Set ws = ActiveSheet
    ws.Name = wsName
  Next
End Sub

If you want to create your own naming scheme you can follow something similar to this:

Sub createNewWorksheet()
  Dim lRow As Integer
  Dim ws As Worksheet

  lRow = Worksheets("Code and Data Centre").Cells(Rows.Count, 18).End(xlUp).Row

  For i = 4 to lRow
    Sheets("Participant Template").Copy After:=Sheets(Sheets.Count)
    Set ws = ActiveSheet
    ws.Name = "Participant " & (i - 3) 'Custom name
  Next
End Sub

Also you can store the names in a global array to be able to access them later. Maybe for deleting:

Dim sheetNames() As Variant
Sub createNewWorksheet()
  Dim lRow As Integer
  Dim ws As Worksheet

  lRow = Worksheets("Code and Data Centre").Cells(Rows.Count, 18).End(xlUp).Row

  For i = 4 to lRow
    Sheets("Participant Template").Copy After:=Sheets(Sheets.Count)
    Set ws = ActiveSheet
    ReDim sheetNames(i-3)
    sheetNames(i-3) = "Participant " & (i - 3) 'Custom name
    ws.Name =  sheetNames(i-3)
  Next
End Sub
Sub deleteWorksheets()
  For Each wsName In sheetNames
    Worksheets(wsName).Delete
  Next
End Sub

Ofcourse name list stored in sheetNames will be flushed out every time you close the workbook.

 

[The_Steward]

Yes, that should be also column 18.

 lRow = Worksheets("Code and Data Centre").Cells(Rows.Count, 18).End(xlUp).Row

Yes that's what I thought, then I realised I had to change 'Worksheets' to 'Sheet'.

I also temproraily renamed worksheets variable to worksheetss and some other quick fixes.

Now I am just struggling to wrap my head around how the paste method is working. getting the error "PasteSpecial method of range class failed'

Sub copyData()
  Dim workSheetss As Variant
  Dim lRow As Integer
  lRow = Sheets("Code and Data Centre").Cells(Rows.Count, 18).End(xlUp).Row
 
  workSheetss = Sheets("Code and Data Centre").Range("R4:R" & lRow).Value
  For Each ws In workSheetss
    With workSheets(ws)
      Dim DataToCopy As Range
      Set DataToCopy = Sheets("Participant1").Range("A1:ZZ100") 'You should set your own used range from Participant1 sheet.
      If Not DataToCopy Is Nothing Then
        DataToCopy.Copy
        Range("A1:ZZ100").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, SkipBlanks:=True 'Again you should set your own target range other than A1 in client sheets.
        'SkipBlanks enables to keep of destination data if the source data is empty. Delete it if you want to override values.
      End If
    End With
  Next
End Sub

Thankyou so much for all your suggestions with the naming schemes, i'll those out later if I get the chance.

 

[Legacy 143009]

Rearreange this part like this:

For Each ws In workSheetss
    With Worksheets(ws)
      Dim DataToCopy As Range
      Set DataToCopy = Sheets("Participant1").Range("A1:ZZ100")
      If Not DataToCopy Is Nothing Then
        DataToCopy.Copy
        .Range("A1:ZZ100").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, SkipBlanks:=True
      End If
    End With
  Next

 

[Legacy 143009]

Even you don't have to use a With statement there since you are not doing much with the new sheet. Also you can move set dimension out of For loop. Since you will use the same source data for all sheets. It will be more faster:

  Dim DataToCopy As Range
  Set DataToCopy = Sheets("Participant1").Range("A1:ZZ100")
  For Each ws In workSheetss
    If Not DataToCopy Is Nothing Then
      DataToCopy.Copy
      Worksheets(ws).Range("A1:ZZ100").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, SkipBlanks:=True
    End If
  Next