Creating Sheets from Column Using Template Sheet and Copy Cells to Created Sheet

[xavier12]

Hello,

I have a data management I am working on. So far it is great but needs to be tweaked. I have a sheets 'Master', 'Template'. In Master in column A, I have a ID which is generated from three different variables. The ID uses concatenate formula from column B, D, and F as shown in the image attached. Currently I have to manually type in the ID in column A because when I change my code below from
Set shNAMES = wsMASTER.Range("A2:A" & Rows.Count).SpecialCells(xlConstants) to xl(Formulas) (replace xlConstants to xl(Formulas)) it generates the sheets based off ID but also creates an additional template sheet everytime. Anybody know how to fix this?

The code creates new sheets from Master column A and renames the sheet to column A cells using template sheet, and does not create duplicates and displays message.

Option Explicit

Sub SheetsFromTemplate()
Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean
Dim shNAMES As Range, Nm As Range

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("A2:A" & Rows.Count).SpecialCells(xlConstants)     'or xlFormulas
   
    Application.ScreenUpdating = False                              'speed up macro
    For Each Nm In shNAMES                                          'check one name at a time
        If Not Evaluate("ISREF('" & CStr(Nm.Text) & "'!A1)") Then   'if sheet does not exist...
            wsTEMP.Copy After:=.Sheets(.Sheets.Count)               '...create it from template
            ActiveSheet.Name = CStr(Nm.Text)                        '...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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

For this next part I want to create a second macro to run after sheets are created (I do not think it can be all under macro but if possible that would be better) The second macro is to; In Master there is a drop down to select status of ID that can be changed depending on status. I need to be able to copy that status into the new sheets created from the code above and be able to rerun this code to update the ID sheets depending on how master status is changed. Below is picture of template and in B1 would auto copy the ID from Master and B2 would have this status that can be updated from Master into the ID sheet. See pictures attached for Template and an example ID sheet.

Thank you in advance for taking the time to read this and help me out!

Regards,
Xavier

 

[mumps]

Place this macro in a regular module:

Sub SheetsFromTemplate()
    Dim wsMASTER As Worksheet, wsTEMP As Worksheet, wasVISIBLE As Boolean
    Dim shNAMES As Range, Nm As Range
    Set wsTEMP = Sheets("Template")
    wasVISIBLE = (wsTEMP.Visible = xlSheetVisible)
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetVisible
    Set wsMASTER = Sheets("Master")
    Set shNAMES = wsMASTER.Range("A2", Range("A" & Rows.Count).End(xlUp))
    Application.ScreenUpdating = False
    For Each Nm In shNAMES
        If Not Evaluate("ISREF('" & CStr(Nm) & "'!A1)") Then
            wsTEMP.Copy After:=Sheets(Sheets.Count)
            With ActiveSheet
                .Name = CStr(Nm.Text)
                .Range("B1") = Nm.Value
                .Range("B2") = Nm.Offset(, 7)
            End With
        End If
    Next Nm
    wsMASTER.Activate
    If Not wasVISIBLE Then wsTEMP.Visible = xlSheetHidden
    Application.ScreenUpdating = True
    MsgBox "All sheets created"
End Sub

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your Master sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. After you have run the above macro, you can change the status in column G and press the ENTER key to update the status in the ID sheets.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 8 Then Exit Sub
    Sheets(Target.Offset(, -7).Value).Range("B2") = Target
End Sub

 

[xavier12]

Thank you for your quick response!
When I try to run the regular module I get error as shown.

 

[mumps]

Which line of code is highlighted when you click "Debug"?

 

[xavier12]

Which line of code is highlighted when you click "Debug"?

Set shNAMES = wsMASTER.Range("A2", Range("A" & Rows.Count).End(xlUp))

 

[mumps]

Click here to download a sample file. The ID in column A is the result of a formula. Run the macro in Module1. Have a look at this file and compare it to your actual file to see if how the data is organized is the same.

 

[xavier12]

Click here to download a sample file. The ID in column A is the result of a formula. Run the macro in Module1. Have a look at this file and compare it to your actual file to see if how the data is organized is the same.

Yes my workbook is the same setup as the sample file.

 

[mumps]

Did the macro work properly in the sample file I uploaded? If it did, perhaps you could upload a copy of your actual file (de-sensitized if necessary) to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here.

 

[Marc L]

Hi,​

​

before any dropbox link just try the correction of the classic Range trap :​

Set shNAMES = wsMASTER.Range("A2", wsMASTER.Range("A" & Rows.Count).End(xlUp))

 

[xavier12]

Hi,​

​

before any dropbox link just try the correction of the classic Range trap :​

Set shNAMES = wsMASTER.Range("A2", wsMASTER.Range("A" & Rows.Count).End(xlUp))

Thank you this did the job!

Thanks a lot mumps, very helpful!