VBA Code to Create A New Sheet from a Template and Rename it from a List

[grace12]

Hi All,

I have a workbook that I am using to track all my new clients.

I have a worksheet called 'MasterData' that lists all my client names in Column B(Cell B3 and beyond) and this is formatted as a table. Column B currently has 52 entries and I keep adding to the list. I also have a worksheet called 'Template' having some basic formulas, which is to be copied. There are existing sheets for 35 client names (1 worksheet per client) in no particular order.

I want to run a macro 'CreateSheet' that copies the worksheet 'Template' along with its formulas to a new worksheet and rename it to a missing client name. At the same time, if a worksheet with the client name exists, I want excel to ignore it (keep the existing data intact) and move to the next. If worksheets exists for all clients, then I want to get a message 'All Client Sheets Updated'.

Please also note my Worksheets are not in order. For example MasterData is Sheet 4 and Template is sheet 42.

Please help.

 

[jbeaucaire]

Eek! My bad. We don't want to "activate" sheets, my command is missing that sheetname connected to it:

Nm.Resize(, 500).Copy Worksheets(NmSTR).Range("C" & Rows.Count).End(xlUp).Offset(1)

Looking at your other question now.

 

[jbeaucaire]

Ok, a little more additions to make it easier to understand and use:

Option Explicit

Sub SheetsFromTemplate()
'Jerry Beaucaire - 10/22/2014
'Create copies of a template sheet using text on a master sheet in a specific column
'Sheetname strings are corrected using the UDF below
Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean
Dim shNAMES As Range, Nm As Range, NmSTR As String, NR As Long

With ThisWorkbook                                               'keep focus in this workbook
    Set wsTEMP = .Sheets("Template")                            'sheet to be copied
    wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)              'check if it's hidden or not
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible      'make it visible
    
    Set wsMASTER = .Sheets("Master")                            'sheet with names
                                                                'range to find names to be checked
    Set shNAMES = wsMASTER.Range("B3:B" & Rows.Count).SpecialCells(xlConstants)     'or xlFormulas
    
    Application.ScreenUpdating = False                          'speed up macro
    For Each Nm In shNAMES                                      'check one name at a time
        NmSTR = FixStringForSheetName(CStr(Nm.Text))            'use UDF to create a legal sheetname
        If Not Evaluate("ISREF('" & NmSTR & "'!A1)") Then       'if sheet does not exist...
            wsTEMP.Copy After:=.Sheets(.Sheets.Count)           '...create it from template
            ActiveSheet.Name = NmSTR                            '...rename it
        End If
        With .Sheets(NmSTR)
            NR = .Range("C" & .Rows.Count).End(xlUp).Offset(1).Row
            wsMASTER.Range("B1:B2").Copy
            .Range("A" & NR).PasteSpecial xlPasteValues, Transpose:=True
            Nm.Resize(, 500).Copy .Range("C" & NR)
        End With
    Next Nm
    
    wsMASTER.Activate                                           'return to the master sheet
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden       'hide the template if necessary
    Application.ScreenUpdating = True                           'update screen one time at the end
End With

MsgBox "All sheets created"
End Sub


Function FixStringForSheetName(shSTR As String) As String

'replace each forbidden character with something acceptable
    shSTR = Replace(shSTR, ":", "")
    shSTR = Replace(shSTR, "?", "")
    shSTR = Replace(shSTR, "*", "")
    shSTR = Replace(shSTR, "/", "-")
    shSTR = Replace(shSTR, "\", "-")
    shSTR = Replace(shSTR, "[", "(")
    shSTR = Replace(shSTR, "]", ")")

'sheet names can only be 31 characters
    FixStringForSheetName = Trim(Left(shSTR, 31))

End Function

 

[pyrokidd89]

That works perfectly. However it seems my data has some sort of formatting and its color filling the cells when its pastes to the new sheet Im sure this has to do with the program im pulling the data from. Is there a way to add paste special to your code? I will look into doing it myself after work today if you dont get to it first.

 

[pyrokidd89]

Actually I think I got it. Here is what I came up with please let me know if there is a better way:

 With .Sheets(NmSTR)
            NR = .Range("C" & .Rows.Count).End(xlUp).Offset(1).Row
            wsMASTER.Range("B1:B2").Copy
            .Range("A" & NR).PasteSpecial xlPasteValues, Transpose:=True
            Nm.Resize(, 500).Copy
            .Range("C" & NR).PasteSpecial xlPasteValuesAndNumberFormats  'Paste Special to remove formating
        End With

 

[crannytran]

This is very old but I am hoping that someone can help me. I tried to run this code and I am getting an error in this line which states that "no cells were found". Any help you can offer would be extremely appreciated. Thank you!

Option Explicit

Private Sub CommandButton1_Click()


'Jerry Beaucaire - 10/22/2014
'Create copies of a template sheet using text on a master sheet in a specific column
'Sheetname strings are corrected using the UDF below


Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean
Dim shNAMES As Range, Nm As Range, NmSTR As String


With ThisWorkbook                                               'keep focus in this workbook
    Set wsTEMP = .Sheets("Template")                            'sheet to be copied
    wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)              'check if it's hidden or not
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible      'make it visible
    
    Set wsMASTER = .Sheets("Setup")                            'sheet with names
                                                                'range to find names to be checked
    [COLOR=#ff0000]Set shNAMES = wsMASTER.Range("C7:C" & Rows.Count).SpecialCells(xlConstants) [/COLOR]    'or xlFormulas
    
    Application.ScreenUpdating = False                          'speed up macro
    For Each Nm In shNAMES                                      'check one name at a time
        NmSTR = FixStringForSheetName(CStr(Nm.Text))            'use UDF to create a legal sheetname
        If Not Evaluate("ISREF('" & NmSTR & "'!A1)") Then       'if sheet does not exist...
            wsTEMP.Copy After:=.Sheets(.Sheets.Count)           '...create it from template
            ActiveSheet.Name = NmSTR                            '...rename it
        End If
    Next Nm
    
    wsMASTER.Activate                                           'return to the master sheet
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden       'hide the template if necessary
    Application.ScreenUpdating = True                           'update screen one time at the end
End With


MsgBox "All sheets created"
End Sub




Function FixStringForSheetName(shSTR As String) As String


'replace each forbidden character with something acceptable
    shSTR = Replace(shSTR, ":", "")
    shSTR = Replace(shSTR, "?", "")
    shSTR = Replace(shSTR, "*", "")
    shSTR = Replace(shSTR, "/", "-")
    shSTR = Replace(shSTR, "\", "-")
    shSTR = Replace(shSTR, "[", "(")
    shSTR = Replace(shSTR, "]", ")")


'sheet names can only be 31 characters
    FixStringForSheetName = Trim(Left(shSTR, 31))


End Function

 

[jbeaucaire]

That line of code is trying to make a "range" object using all the cells in C7:C(bottom of sheet) that have flat values (constants) in them. Let me guess yours has formulas? If so, change that to xlFormulas.

 

[crannytran]

Thank you for your quick response! My C7:C cells have a concatenate() and your suggestion fixed that line but then the FixStringForSheetName line bugged. I am fairly new to VBA so I think your code is a little too advanced for me.

I am going with a much simpler code but I would like it to scan the list of names first and if it finds a duplicate, show a message box and not run the macro to create copies of the sheets at all. This is what I am using now but it creates copies of sheets until it encounters a duplicate and then it throws up the message box & a confirm delete box. Can you help?

Private Sub CommandButton4_Click()

'Add sheet based on list
    Dim i As Integer
    Dim wks As Worksheet
    Dim Last_Row As Long
    
'Run the Error handler "ErrHandler" when an error occurs.
    On Error GoTo Errhandler
    
    Set wks = Sheets("Setup")
    
    Last_Row = wks.Cells(Rows.Count, 1).End(xlUp).Row
    
     For i = 7 To Last_Row
         With Sheets("Template")
            .Copy Before:=Sheets("WUBEAR")
            ActiveSheet.Name = wks.Cells(i, 3)
            ActiveSheet.Cells(1, 1) = wks.Cells(i, 3)
          End With
    Next
    Exit Sub
    
Errhandler:
    
    'If an error occurs, display message and end the macro.
    MsgBox "You have entered a duplicate subcontractor/carrier combination.  Please correct & retry."
    Sheets("Template (2)").Delete
    
End Sub

Thank you so much for your time.

 

[DRWonoski]

Really old bump but does anyone know how to modify this code so to fit what I need?

I have a userform that creates a new row at the bottom of a table and sets txtName as the value in cell A of that row. I want that to then create a new worksheet, based on a template, and name it what is in cell A. Any thoughts on how to modify this to fit? I don't need a new sheet created for every row in the table, just the new one I am adding but I would like to check it for proper naming conventions. Thanks

 

[JLBURCH]

Dear Members
Thank you in advance for your awesome work! I really like the Makro from jbeaucaire! But finally I always receive a Error at the Line:

If Not Evaluate("ISREF('" & CStr(Nm.Text) & "'!A1)") Then

To where does the "!A1" reference? It doesn't matter what I do, I dont get the Makro working right.

May please someone be so kind, to help me out?

Thank you a lot and have a pleasant day!

Best regards
Jean

 

[jbeaucaire]

When you receive the error and DEBUG, what is the value of Nm.Text?