Automatically create and name varying of template sheets based on cell values in multiple cell ranges of the master sheet.

[BokiRis]

Hello,

I am trying to accomplish the following:

In my workbook I have a master spreadsheet named PLC Config. In PLC Config there are eight different cell value options (SPARE,ECOM,AI,AO,AIAO,DI,DO,DIDO) for cell range B12:N12. The same cell value options are present in cell ranges B15:N15, B18:N18, B21:N21, B24:N24, and B27:N27. I also have six different template sheets (AI template, AO Template, AIAO Template, DI, Template, DO Template, and DIDO Template. I would like to be able to generate a new sheet as one of the templates depending on the value of the cell in above mentioned ranges. I however, do not want to generate any additional sheets if the values are SPARE or ECOM. In addition, I would like to name each new sheet using the value from the corresponding cell from a row below the above specified ranges. Meaning, use the value from a cell in range B13:N13 to name sheet created from a cell in range B12:N13 and perform the similar for the other ranges.

For example:

If the value in cell B12 is AI, create a new sheet called AI PLC Slot 1 (derived from cell B13). For cell value AO in C12, create AO PLC Slot 2 (derived from cell C13), and so on for the rest of the cells in range B12:N12. Preform similar for cell range B15:N15 using cell range B16:N16 for new sheet name and so on.

I hope my narrative makes sense.

Any help is greatly appreciated

 

[onlyadrafter]

Hello,

Does this suit your needs?

Sub CREATE_SHEETS()
    With Sheets("PLC Config")
        For MY_ROWS = 12 To 28 Step 3
            For MY_COLS = 2 To 14
                If .Cells(MY_ROWS, MY_COLS).Value <> "SPARE" And .Cells(MY_ROWS, MY_COLS).Value <> "ECOM" Then
                    a = .Cells(MY_ROWS, MY_COLS).Value & " Template"
                    Sheets(.Cells(MY_ROWS, MY_COLS).Value & " Template").Copy after:=Sheets(Sheets.Count)
                    ActiveSheet.Name = .Cells(MY_ROWS, MY_COLS).Value & " " & .Cells(MY_ROWS + 1, MY_COLS).Value
            End If
            Next MY_COLS
        Next MY_ROWS
    End With
End Sub

It has no error trapping for an existing tab. Will this be required?

 

[BokiRis]

Well, I for one am glad that you’re back. Your code is exactly what I’ve been trying to figure out for the last several days and to do it in as few lines as you did is simply magic. I can’t thank you enough!!!

One thing I forgot to mention, based on my input on the master sheet, not all cells in the row range will have values, as well as not all ranges will be active. I have slightly altered the code on line 5 and included ~~ And .Cells(MY_ROWS, MY_COLS).Value <> "" ~~. The script now executes perfectly even when some of the calling cells are blank, however, if I don’t have all the rows engaged, the script executes but with an error and couple copies of some random sheets. Points to line 8 and error is "Run-time error "1004": that name is already taken. Try a different one.

To answer your earlier question:

Cell values used for naming are all unique so each new tab will have a unique name as well. As such, error trapping for an existing tab will not be required, but thank you for bringing that up. On the other hand, since I would potentially be creating up to 78 new tabs, I would love to be able to create a Hyperlink on the Master sheet “PLC Config” for the naming cells (in ranges B13:N13, B16:N16, B19:N19, B22:N22, B25:N25, and B28:N28) so that I can navigate to desired tab from the master sheet little bit easier.

One other feature that would be wonderful, would be to automatically run the script if any changes are made to, one or the other, either calling cells (rows 12, 15, 18, 21, 24, 27) or naming cells (rows 13, 16, 19, 22, 25, 28) on the master sheet.
If it’s not too much trouble, I could use some additional help with these few additional items. If you think it's better, I could post a separate thread for clarity.

Again, thank you so much for all your help!!!!

 

[onlyadrafter]

Hello,

Code for hyperlink and checking for blank cells:

Sub CREATE_SHEETS()
    With Sheets("PLC Config")
        For MY_ROWS = 12 To 28 Step 3
            For MY_COLS = 2 To 14
                If .Cells(MY_ROWS, MY_COLS).Value <> "SPARE" And .Cells(MY_ROWS, MY_COLS).Value <> "ECOM" And _
                    Not IsEmpty(.Cells(MY_ROWS, MY_COLS).Value) Then
                    Sheets(.Cells(MY_ROWS, MY_COLS).Value & " Template").Copy after:=Sheets(Sheets.Count)
                    ActiveSheet.Name = .Cells(MY_ROWS, MY_COLS).Value & " " & .Cells(MY_ROWS + 1, MY_COLS).Value
                    .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Hyperlinks.Add Anchor:=.Range("A" & Rows.Count).End(xlUp).Offset(1, 0), Address:="", SubAddress:= _
                    "'" & .Cells(MY_ROWS, MY_COLS).Value & " " & .Cells(MY_ROWS + 1, MY_COLS).Value & "'!A1", TextToDisplay:="'" & .Cells(MY_ROWS, MY_COLS).Value & " " & .Cells(MY_ROWS + 1, MY_COLS).Value
            End If
            Next MY_COLS
        Next MY_ROWS
    End With
End Sub

Not sure how you are getting the run time error.

 

[onlyadrafter]

Hello,

and here is the code for when changes have been made. Not sure yow you want to handle tabs that are no longer listed in the ranges above

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Row = 12 Or Target.Row = 15 Or Target.Row = 18 Or Target.Row = 21 Or Target.Row = 24 Or Target.Row = 27 And _
            Target.Column >= 12 And Target.Column <= 14 Then
                If Target.Value <> "SPARE" And Target.Value <> "ECOM" And Not IsEmpty(Target.Value) Then
                    Sheets(Target.Value & " Template").Copy after:=Sheets(Sheets.Count)
                    ActiveSheet.Name = Target.Value & " " & Target.Offset(1, 0).Value
                    Sheets("PLC Config").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Hyperlinks.Add Anchor:=Sheets("PLC Config").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) _
                        , Address:="", SubAddress:="'" & Target.Value & " " & Target.Offset(1, 0).Value & "'!A1", TextToDisplay:="'" & Target.Value & " " & Target.Offset(1, 0).Value
            End If
    End If
    If Target.Row = 13 Or Target.Row = 16 Or Target.Row = 19 Or Target.Row = 22 Or Target.Row = 25 Or Target.Row = 28 And _
            Target.Column >= 12 And Target.Column <= 14 Then
                If Target.Value <> "SPARE" And Target.Value <> "ECOM" And Not IsEmpty(Target.Value) Then
                    Sheets(Target.Offset(-1, 0).Value & " Template").Copy after:=Sheets(Sheets.Count)
                    ActiveSheet.Name = Target.Offset(-1, 0).Value & " " & Target.Value
                    Sheets("PLC Config").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Hyperlinks.Add Anchor:=Sheets("PLC Config").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) _
                        , Address:="", SubAddress:="'" & Target.Offset(-1, 0).Value & " " & Target.Value & "'!A1", TextToDisplay:="'" & Target.Offset(-1, 0).Value & " " & Target.Value
            End If
    End If
    Application.EnableEvents = True
End Sub

This code needs to go into the code window of the PLC Config tab, not a standard module.

 

[BokiRis]

Thank you again. Your code is a thing of beauty. You have addressed all the items that I’ve mentioned. You are amazing!!!

Could I bother you with just one other small request, that I believe would be a breeze for you? Could the code be modified so that the active sheet during input is always the master sheet (PLC Config) so when the new sheet is added, we don’t jump to it immediately? This would eliminate having to jump back and forth each time new sheet is added. Also, would it be possible to the have the hyperlinks for created sheets be displayed in the naming cells instead of column A? For example: If input cell contains B12 is “AI”, then the new sheet and hyperlink would be created and hyperlink would be in cell B13, and so on.

I don't know how to thank you enough for all the work you've been putting in to this. Again, thank you for being part of this forum and willing to help random strangers with limited VBA experience!!!

 

[onlyadrafter]

hello,

Do these work as expected? Not thoroughly tested.

Sub CREATE_SHEETS()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    With Sheets("PLC Config")
        For MY_ROWS = 12 To 28 Step 3
            For MY_COLS = 2 To 14
                    If .Cells(MY_ROWS, MY_COLS).Value <> "SPARE" And .Cells(MY_ROWS, MY_COLS).Value <> "ECOM" And _
                            Not IsEmpty(.Cells(MY_ROWS, MY_COLS).Value) Then
                        Sheets(.Cells(MY_ROWS, MY_COLS).Value & " Template").Copy after:=Sheets(Sheets.Count)
                        ActiveSheet.Name = .Cells(MY_ROWS, MY_COLS).Value & " " & .Cells(MY_ROWS + 1, MY_COLS).Value
                        Sheets("PLC Config").Select
                        .Cells(MY_ROWS + 1, MY_COLS).Hyperlinks.Add Anchor:=.Cells(MY_ROWS + 1, MY_COLS), Address:="", SubAddress:= _
                        "'" & .Cells(MY_ROWS, MY_COLS).Value & " " & .Cells(MY_ROWS + 1, MY_COLS).Value & "'!A1", TextToDisplay:="'" & .Cells(MY_ROWS, MY_COLS).Value & " " & .Cells(MY_ROWS + 1, MY_COLS).Value
                 End If
            Next MY_COLS
        Next MY_ROWS
    End With
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

and

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Target.Row = 12 Or Target.Row = 15 Or Target.Row = 18 Or Target.Row = 21 Or Target.Row = 24 Or Target.Row = 27 And _
            Target.Column >= 12 And Target.Column <= 14 Then
                If Target.Value <> "SPARE" And Target.Value <> "ECOM" And Not IsEmpty(Target.Value) Then
                    Sheets(Target.Value & " Template").Copy after:=Sheets(Sheets.Count)
                    ActiveSheet.Name = Target.Value & " " & Target.Offset(1, 0).Value
                    Sheets("PLC Config").Select
                    Target.Offset(1, 0).Hyperlinks.Add Anchor:=Target.Offset(1, 0) _
                        , Address:="", SubAddress:="'" & Target.Value & " " & Target.Offset(1, 0).Value & "'!A1", TextToDisplay:="'" & Target.Value & " " & Target.Offset(1, 0).Value
            End If
    End If
    If Target.Row = 13 Or Target.Row = 16 Or Target.Row = 19 Or Target.Row = 22 Or Target.Row = 25 Or Target.Row = 28 And _
            Target.Column >= 12 And Target.Column <= 14 Then
                If Target.Value <> "SPARE" And Target.Value <> "ECOM" And Not IsEmpty(Target.Value) Then
                    Sheets(Target.Offset(-1, 0).Value & " Template").Copy after:=Sheets(Sheets.Count)
                    ActiveSheet.Name = Target.Offset(-1, 0).Value & " " & Target.Value
                    Sheets("PLC Config").Select
                    Target.Hyperlinks.Add Anchor:=Target _
                        , Address:="", SubAddress:="'" & Target.Value & " " & Target.Value & "'!A1", TextToDisplay:="'" & Target.Value & " " & Target.Offset(1, 0).Value
            End If
    End If
    Application.EnableEvents = True
End Sub

 

[BokiRis]

I don't know how to thank you enough. This is simply brilliant. Your code functions perfectly. I am amazed at your skills and what you can do with VBA in Excel. Thank you, thank you, thank you!!!