Trying to Copy Worksheet and rename via userform

[Jeff-Q]

I'm creating a worksheet for my wife to manage a roster for her bootcamp clientele. I have successfully created the userform that runs from a macro button for adding new clients to the roster. When running the userform VBA, several data fields are generated for each new client in several columns of a single row (name, email, phone number, etc). I am trying to create an individual worksheet for each client on the roster, based on a standard template (currently titled "Measurements"), using the userform. Here is what I am hoping the userform or macro to do:

- Upon adding a new client using the userform, copy the "measurements template" worksheet with a new worksheet name equal to the client's full name (the client's full name would be in cell B3 of the new client measurements worksheet and would be linked to the corresponding worksheet cell on the "roster" worksheet [in column "A"]).

I've reached a bit of an impass for copying the template worksheet based on the newly added client using the userform. I do intend to polish the macro for the roster worksheet to re-sort the clientele alphabetically... but that's easy stuff. Haven't done a lot with userforms, and I'm a bit rusty on what code to use for copying and renaming worksheets. I'm also curious if it is possible to re-sort the worksheets in alphabetical order after adding a new client (this isn't essential though). I would also like to create a hyperlink on each clients name of the "roster" worksheet that opens their corresponding "measurements" worksheet.

Any help would be greatly appreciated. I have stored a copy of the worksheet at the following: http://dl.dropbox.com/u/37265601/TFC/TFC_Roster-Data.xlsm

This forum is awesome and I truly appreciate you all who contribute. Blessings!

Jeff

 

[bertie]

I have made some amendments to the code behind your OK button.

When working with multiple worksheets it is not advisable to use ActiveSheet or Select, you can easily lose track of which sheet you are working on. Instead use variables to control which worksheet is active.

   [COLOR=darkblue]Dim[/COLOR] wsRoster [COLOR=darkblue]As[/COLOR] Worksheet
   [COLOR=darkblue]Dim[/COLOR] wsTemp [COLOR=darkblue]As[/COLOR] Worksheet
 
   [COLOR=darkblue]Set[/COLOR] wsRoster = Sheets("ROSTER")
   [COLOR=darkblue]Set[/COLOR] wsTemp = Sheets("Measurements Template")

Calculate the first empty row.

   [COLOR=green]'Determine EmptyRow[/COLOR]
   emptyRow = WorksheetFunction.CountA([COLOR=red]wsRoster[/COLOR].Range("A:A")) + 1

I have used a With...End With statement for sending the values to the Roster worksheet. For example:

   [COLOR=green]'Export Data to worksheet[/COLOR]
   [COLOR=darkblue]With[/COLOR] wsRoster
      .Cells(emptyRow, 1).Value = NameTextBox.Value
      .Cells(emptyRow, 2).Value = PhoneTextBox.Value
    [COLOR=seagreen]'etc[/COLOR]

The name of the new sheet, i.e., the client's name, will be part of the hyperlink and cannot have any spaces. So I have replaced the spaces with an underscore.

   [COLOR=green]'get the new sheet name and remove any spaces with underscore[/COLOR]
   [COLOR=green]'we can't have spaces in the hyperlink[/COLOR]
   sheetName = Replace(NameTextBox.Value, " ", "_", vbTextCompare)

Then we copy and rename the template:

   [COLOR=green]'copy and rename the template and place client's name in cell B3[/COLOR]
   wsTemp.Copy After:=Sheets(1)
   ActiveSheet.Name = sheetName
   Sheets(sheetName).Range("B3").Value = NameTextBox.Value

Now the new worksheet is in place we can create the hyperlink:

   [COLOR=green]'add hyperlink to the ROSTER worksheet[/COLOR]
    wsRoster.Cells(emptyRow, 1).Hyperlinks.Add _
      Anchor:=wsRoster.Cells(emptyRow, 1), _
      Address:="", _
      SubAddress:=sheetName & "!B3", _
      TextToDisplay:=NameTextBox.Value

The "SubAddress" is the cell the hyperlink goes to on the new sheet.


The full amended code for the OKButton is shown below.

[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] OKButton_Click()
   [COLOR=darkblue]Dim[/COLOR] emptyRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] sheetName [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
   [COLOR=darkblue]Dim[/COLOR] wsRoster [COLOR=darkblue]As[/COLOR] Worksheet
   [COLOR=darkblue]Dim[/COLOR] wsTemp [COLOR=darkblue]As[/COLOR] Worksheet
   [COLOR=darkblue]Set[/COLOR] wsRoster = Sheets("ROSTER")
   [COLOR=darkblue]Set[/COLOR] wsTemp = Sheets("Measurements Template")
 
   [COLOR=green]'Determine EmptyRow[/COLOR]
   emptyRow = WorksheetFunction.CountA(wsRoster.Range("A:A")) + 1
 
   [COLOR=green]'Export Data to worksheet[/COLOR]
   [COLOR=darkblue]With[/COLOR] wsRoster
      .Cells(emptyRow, 1).Value = NameTextBox.Value
      .Cells(emptyRow, 2).Value = PhoneTextBox.Value
      .Cells(emptyRow, 3).Value = AddressTextBox.Value
      .Cells(emptyRow, 4).Value = EmailTextBox.Value
      .Cells(emptyRow, 5).Value = BirthdayTextBox.Value
      .Cells(emptyRow, 6).Value = BootcampComboBox.Value
      .Cells(emptyRow, 7).Value = StartDateBox3.Value
      .Cells(emptyRow, 8).Value = GoalTextBox.Value
 
      [COLOR=darkblue]If[/COLOR] HQOptionButton1.Value = [COLOR=darkblue]True[/COLOR] [COLOR=darkblue]Then[/COLOR]
         .Cells(emptyRow, 9).Value = "Yes"
      [COLOR=darkblue]Else[/COLOR]
         .Cells(emptyRow, 9).Value = "No"
      [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
      [COLOR=darkblue]If[/COLOR] BEFOREOptionButton1.Value = [COLOR=darkblue]True[/COLOR] [COLOR=darkblue]Then[/COLOR]
          .Cells(emptyRow, 10).Value = "Yes"
      [COLOR=darkblue]Else[/COLOR]
          .Cells(emptyRow, 10).Value = "No"
      [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
      [COLOR=darkblue]If[/COLOR] AFTEROptionButton1.Value = [COLOR=darkblue]True[/COLOR] [COLOR=darkblue]Then[/COLOR]
          .Cells(emptyRow, 11).Value = "Yes"
      [COLOR=darkblue]Else[/COLOR]
          .Cells(emptyRow, 11).Value = "No"
      [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
   [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
   [COLOR=green]'get the new sheet name and remove any spaces with underscore[/COLOR]
   [COLOR=green]'we can't have spaces in the hyperlink[/COLOR]
   sheetName = Replace(NameTextBox.Value, " ", "_", vbTextCompare)
 
  [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] errhandler
 
  Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
 
   [COLOR=green]'copy and rename the template and place client's name in cell B3[/COLOR]
   wsTemp.Copy After:=Sheets(1)
   ActiveSheet.Name = sheetName
   Sheets(sheetName).Range("B3").Value = NameTextBox.Value
 
   [COLOR=green]'add hyperlink to the ROSTER worksheet[/COLOR]
    wsRoster.Cells(emptyRow, 1).Hyperlinks.Add _
      Anchor:=wsRoster.Cells(emptyRow, 1), _
      Address:="", _
      SubAddress:=sheetName & "!B3", _
      TextToDisplay:=NameTextBox.Value
 
    wsRoster.Activate
 
errhandler:
  Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
  [COLOR=darkblue]Set[/COLOR] wsTemp = [COLOR=darkblue]Nothing[/COLOR]
  [COLOR=darkblue]Set[/COLOR] wsRoster = [COLOR=darkblue]Nothing[/COLOR]
End [COLOR=darkblue]Sub[/COLOR]

Setting the worksheet variables to Nothing clears the memory which was set aside to handle them.

If you create a hyperlink on your template to go HOME to the Roster sheet then you won't need to worry about sorting the worksheets.

Hope this helps,
Bertie

 

[Jeff-Q]

Fantastic, Bertie! Works beautifully! Thank you so much for your help and for taking the time.

Blessings to you!

Jeff

 

[Jeff-Q]

Okay, thanks to Bertie's help, I have a lot of happy personal trainers using the new roster spreadsheet. However, a few of them are working on Macs and I understand that the windows VBA code is not compatible with whatever Mac uses. Anyone out there able to convert the final product to work on Mac? I have never worked on a Mac and have no clue.

Final product is here: http://dl.dropbox.com/u/37265601/TFC/TFC_Roster-Data-RV4.xlsm

 

[kittyggirl]

Good work!

 

[eyong123]

Hi dear i have similar problem and i need your help.

I my case I have 7 sheets corresponding to 7 consecutive days. i will like to use a userform to input week start date of next week in one of the sheets and this automatically renames all the sheets with dates as 7 consecutive days beginning from weekstart date inputed in the textbox.
I already have a code to delete all previous entries in the worksheets that I want to rename before they are renamed.

Also I wil like the workbook to be first saved,
afterthe rename save a copy with name difference only in week number

I look forward to your support

Thanks

 

[eyong123]

Sub StartNewWeek()

Application.ScreenUpdating = False 'speed up macro execution
Application.EnableEvents = False 'turn off other macros for now
Application.DisplayAlerts = False 'turn off system messages for now


On Error Resume Next
ActiveWorkbook.Save
ActiveWorkbook.Sheets(Format(Range("DT60"), "dd.mm.yy")).Activate
With ActiveSheet
Call DeleteEntireDay
End With

ActiveWorkbook.Sheets(Format(Range("DT61"), "dd.mm.yy")).Activate
With ActiveSheet
Call DeleteEntireDay
End With

ActiveWorkbook.Sheets(Format(Range("DT62"), "dd.mm.yy")).Activate
With ActiveSheet
Call DeleteEntireDay
End With

ActiveWorkbook.Sheets(Format(Range("DT63"), "dd.mm.yy")).Activate
With ActiveSheet
Call DeleteEntireDay
End With

ActiveWorkbook.Sheets(Format(Range("DT64"), "dd.mm.yy")).Activate
With ActiveSheet
Call DeleteEntireDay
End With

ActiveWorkbook.Sheets(Format(Range("DT65"), "dd.mm.yy")).Activate
With ActiveSheet
Call DeleteEntireDay
End With


ActiveWorkbook.Sheets(Format(Range("DT66"), "dd.mm.yy")).Activate
With ActiveSheet
Call DeleteEntireDay
End With


ActiveWorkbook.Sheets(Format(Range("DT60"), "dd.mm.yy")).Activate
With ActiveSheet
Range("DT60").Value = txtWeekstartdate
ActiveSheet.Name = Range("DT60").Value
End With

ActiveWorkbook.Sheets(Format(Previous.Range("DT61"), "dd.mm.yy")).Activate
With ActiveSheet
Range("DT60").Value = txtWeekstartdate
ActiveSheet.Name = Range("DT61").Value
End With

ActiveWorkbook.Sheets(Format(Previous.Range("DT62"), "dd.mm.yy")).Activate
With ActiveSheet
Range("DT60").Value = txtWeekstartdate
ActiveSheet.Name = Range("DT62").Value
End With

ActiveWorkbook.Sheets(Format(Previous.Range("DT63"), "dd.mm.yy")).Activate
With ActiveSheet
Range("DT60").Value = txtWeekstartdate
ActiveSheet.Name = Range("DT63").Value
End With

ActiveWorkbook.Sheets(Format(Previous.Range("DT64"), "dd.mm.yy")).Activate
With ActiveSheet
Range("DT60").Value = txtWeekstartdate
ActiveSheet.Name = Range("DT64").Value
End With

ActiveWorkbook.Sheets(Format(Previous.Range("DT65"), "dd.mm.yy")).Activate
With ActiveSheet
Range("DT60").Value = txtWeekstartdate
ActiveSheet.Name = Range("DT65").Value
End With


ActiveWorkbook.Sheets(Format(Previous.Range("DT66"), "dd.mm.yy")).Activate
With ActiveSheet
Range("DT60").Value = txtWeekstartdate
ActiveSheet.Name = Range("DT66").Value
End With

Application.DisplayAlerts = True 'turn system alerts back on
Application.EnableEvents = True 'turn other macros back on
Application.ScreenUpdating = True 'refreshes the screen




End Sub


hELPPPPPPPPPPPP !

 

[Jeff-Q]

I'm sorry that I'm unable to help right away. I'm currently out of the country until early October and unable to review your issue. The person who was quite helpful with my request may be able to help. Perhaps you can reach "Bertie" directly...