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]

Please upload a version of your Test file that includes the formulas in the Master sheet. Step through the macro one line at a time. Do the following:

-place the cursor anywhere in the macro code
-press the F8 key repeatedly until this line of code is highlighted in yellow

If Not Evaluate("isref('" & Cl.Value & "'!a1)") Then

-place the cursor over "CL.Value"

What message is displayed?

 

[xavier12]

Please upload a version of your Test file that includes the formulas in the Master sheet. Step through the macro one line at a time. Do the following:

-place the cursor anywhere in the macro code
-press the F8 key repeatedly until this line of code is highlighted in yellow

If Not Evaluate("isref('" & Cl.Value & "'!a1)") Then

-place the cursor over "CL.Value"

What message is displayed?

It shows the master sheet column A row 2 cell value

 

[mumps]

In the regular module:

Sub SheetsFromTemplate()
    Application.ScreenUpdating = False
    Dim Cl As Range, ws As Worksheet, lRow As Long
    With Sheets("Master")
        lRow = [match(2,1/(a:a<>""))]
        For Each Cl In .Range("A2:A" & lRow)
           If Not Evaluate("isref('" & Cl.Value & "'!a1)") Then
              Sheets("Template").Copy , Sheets(Sheets.Count)
              With ActiveSheet
                 .Name = Cl.Value
                 With Sheets("Master")
                   .Hyperlinks.Add Anchor:=.Range(Cl.Address), Address:="", SubAddress:="'" & Cl.Value & "'!A1", TextToDisplay:=Sheets(Cl.Value).Name
                End With
                 .Range("B1").Resize(3).Value = WorksheetFunction.Transpose(Array(Cl, Cl.Offset(, 10), Cl.Offset(, 8)))
                 .Range("C2") = Cl.Offset(, 7).Value
                 .Columns.AutoFit
              End With
           End If
        Next Cl
    End With
    Sheets("Master").Activate
    Application.ScreenUpdating = True
End Sub

In the sheet module:

Dim oldSheet As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("C:C,E:E,G:G")) Is Nothing Then Exit Sub
    oldSheet = Range("A" & Target.Row).Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("C:C,E:E,G:G,H:H,K:K")) Is Nothing Then Exit Sub
    Select Case Target.Column
        Case Is = 3, 5, 7
            Sheets(oldSheet).Name = Range("A" & Target.Row).Value
            Sheets(Range("A" & Target.Row).Value).Range("B1") = Range("A" & Target.Row).Value
        Case Is = 8
            Sheets(Target.Offset(, -7).Value).Range("C2") = Target
        Case Is = 11
            Sheets(Target.Offset(, -10).Value).Range("B2") = Target
    End Select
End Sub

The macro is triggered with changes in columns C, E, G, H and K.

 

[xavier12]

In the regular module:

Sub SheetsFromTemplate()
    Application.ScreenUpdating = False
    Dim Cl As Range, ws As Worksheet, lRow As Long
    With Sheets("Master")
        lRow = [match(2,1/(a:a<>""))]
        For Each Cl In .Range("A2:A" & lRow)
           If Not Evaluate("isref('" & Cl.Value & "'!a1)") Then
              Sheets("Template").Copy , Sheets(Sheets.Count)
              With ActiveSheet
                 .Name = Cl.Value
                 With Sheets("Master")
                   .Hyperlinks.Add Anchor:=.Range(Cl.Address), Address:="", SubAddress:="'" & Cl.Value & "'!A1", TextToDisplay:=Sheets(Cl.Value).Name
                End With
                 .Range("B1").Resize(3).Value = WorksheetFunction.Transpose(Array(Cl, Cl.Offset(, 10), Cl.Offset(, 8)))
                 .Range("C2") = Cl.Offset(, 7).Value
                 .Columns.AutoFit
              End With
           End If
        Next Cl
    End With
    Sheets("Master").Activate
    Application.ScreenUpdating = True
End Sub

In the sheet module:

Dim oldSheet As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("C:C,E:E,G:G")) Is Nothing Then Exit Sub
    oldSheet = Range("A" & Target.Row).Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("C:C,E:E,G:G,H:H,K:K")) Is Nothing Then Exit Sub
    Select Case Target.Column
        Case Is = 3, 5, 7
            Sheets(oldSheet).Name = Range("A" & Target.Row).Value
            Sheets(Range("A" & Target.Row).Value).Range("B1") = Range("A" & Target.Row).Value
        Case Is = 8
            Sheets(Target.Offset(, -7).Value).Range("C2") = Target
        Case Is = 11
            Sheets(Target.Offset(, -10).Value).Range("B2") = Target
    End Select
End Sub

The macro is triggered with changes in columns C, E, G, H and K.

Thanks for helping me with this again!
I got the same debug error for same line and when I hover over C1 it says C1.Value = Error 2042
The hyperlinks work nicely!
Also when I update the master with a new status it does not update the ID sheet status.

 

[xavier12]

Thanks for helping me with this again!
I got the same debug error for same line and when I hover over C1 it says C1.Value = Error 2042
The hyperlinks work nicely!
Also when I update the master with a new status it does not update the ID sheet status.

I also noticed when I run the macro to generate sheets and than I went and added another row for a new ID and ran macro again, the sheet was created but the ID sheet did not auto fill the info from master to ID sheet

 

[mumps]

Click here for your file. I have tried a different approach without using the macro that would normally go in the regular module. Start entering data in columns C, E, G, H, I and K and the last column to be populated must be L (Status). Each time you select the status, the new sheet will be created if it doesn't exist. If it does exist and you change the name or status, the ID sheet will be updated.

 

[xavier12]

Click here for your file. I have tried a different approach without using the macro that would normally go in the regular module. Start entering data in columns C, E, G, H, I and K and the last column to be populated must be L (Status). Each time you select the status, the new sheet will be created if it doesn't exist. If it does exist and you change the name or status, the ID sheet will be updated.

Very nice, thank you!
I am going to fill this out and get back to you on it.