VBA Duplicating a sheet then renaming tab, changing tab colour, and adding title based on list of names

[myactiondesign]

Hey everyone,

I'm looking to create a fresh workbook based off a template for OKR goal tracking every quarter.

I have a list of team names and the below code already works to duplicate the template and create new tabs, change the tab names and change the title of the template to the team name.

Sub DuplicateTemplate()
    Dim ws As Worksheet, Number As Range
    For Each Code In Sheets("Inputs").Range("A2", Sheets("Inputs").Range("A" & Rows.Count).End(xlUp))
        Sheets("Template").Copy After:=Worksheets(Worksheets.Count)
        Worksheets(Worksheets.Count).Range("A1") = Code
        Worksheets(Worksheets.Count).Range("B1") = Code.Offset(, 1)
        Worksheets(Worksheets.Count).Name = Code.Offset(, 1)
    Next Code
End Sub

This reads from a table like this:

Code	Names
1	Sample team name
2	Another sample team name

Where I'm struggling is to also change the colour of the tab based on the team name.

What I'd like to do is have a third column with an RGB colour and have the tab colour changed when created.

Can anyone help? Much appreciated and thanks in advance for your time!

Thank you!

 

[Fluff]

Rather than putting the RGB value in a cell, change the cell fill colour & you could use

Sub DuplicateTemplate()
    Dim ws As Worksheet, Number As Range
    For Each Code In Sheets("Inputs").Range("A2", Sheets("Inputs").Range("A" & Rows.Count).End(xlUp))
        Sheets("Template").Copy After:=Worksheets(Worksheets.Count)
        Worksheets(Worksheets.Count).Range("A1") = Code
        Worksheets(Worksheets.Count).Range("B1") = Code.Offset(, 1)
        Worksheets(Worksheets.Count).Name = Code.Offset(, 1)
        Worksheets(Worksheets.Count).Tab.Color = Code.Offset(, 1).Interior.Color
    Next Code
End Sub

 

[Logit]

Another method :

Option Explicit

Sub DoesTheSheetExists()
Dim MyCell As Range, MyRange As Range
Dim ws As Worksheet
      
Application.ScreenUpdating = False
    
Set MyRange = Sheets("Inputs").Range("A1")
Set MyRange = Range(Range("A2"), MyRange.End(xlDown))
    
    For Each MyCell In MyRange
         If SheetExist(MyCell.Value) Then
            GoTo FindNext:
        Else
            Sheets("Template").Copy After:=Sheets(Sheets.Count) 'creates a new worksheet
            Sheets(Sheets.Count).Name = MyCell.Offset(0, 1).Value ' renames the new worksheet
            Sheets(Sheets.Count).Range("A1").Value = MyCell.Value
            Sheets(Sheets.Count).Range("B1").Value = MyCell.Offset(0, 1).Value
            Sheets(Sheets.Count).Tab.ColorIndex = MyCell.Offset(0, 2).Value
        End If
FindNext:
    Next MyCell
      
    Application.ScreenUpdating = True
    Sheets("Inputs").Activate
    Sheets("Inputs").Range("A1").Select
    
  
End Sub

 

Function SheetExist(strSheetName As String) As Boolean
    Dim i As Integer

    For i = 1 To Worksheets.Count
        If Worksheets(i).Name = strSheetName Then
            SheetExist = True
            Exit Function
        End If
    Next i
End Function

Download workbook : Create New Tabs From List, Rename Tab and Color Code.xlsm

 

[myactiondesign]

Rather than putting the RGB value in a cell, change the cell fill colour & you could use

Sub DuplicateTemplate()
    Dim ws As Worksheet, Number As Range
    For Each Code In Sheets("Inputs").Range("A2", Sheets("Inputs").Range("A" & Rows.Count).End(xlUp))
        Sheets("Template").Copy After:=Worksheets(Worksheets.Count)
        Worksheets(Worksheets.Count).Range("A1") = Code
        Worksheets(Worksheets.Count).Range("B1") = Code.Offset(, 1)
        Worksheets(Worksheets.Count).Name = Code.Offset(, 1)
        Worksheets(Worksheets.Count).Tab.Color = Code.Offset(, 1).Interior.Color
    Next Code
End Sub

Thank you so much, that worked an absolute treat!

 

[Fluff]

You're welcome & thanks for the feedback.