VBA help req'd - formatting identically multiple new worksheets in the same workbook

[tbablue]

Hi all. I'm most of the way to where I need to be in this project but can't quite make the last bit. The necessary VBA is beyond me. Any assistance welcomed.

I've been given this project at work. The values in C4:C12 are task reference numbers (79245, 79556, etc). The new sheets created by the macro dont need to contain formula, just empty sheets ready for task info to be typed into them by the user - but to this end should be formatted identically.

My objectives.
1.Any value entered into range C4:12 of worksheet "Top Level" should automatically be a hyperlink. COMPLETE!
2.Any value entered into the same range (C4:C12) should have a new worksheet created for it (if one does not already exist). I allocated this action to clicking a shape rather than a change event simply for the sake of testing. COMPLETE!
3.The newly created worksheets should be named by the corresponding value in C4:C12. COMPLETE!
4.The newly created sheets should all be formatted identically. (I thought a simple copy-&-paste from a template would be easiest - but I cant figure out how to format multiple pages simultaneously. Is this even possible?). NOT COMPLETE!
5.The hyperlinks created in objective 1 should point at a cell in the corresponding new worksheet. NOT COMPLETE!

My code is below.



Sub PointStar1_Click()
Call CreateWorksheets(Sheets("Top Level").Range("C4:C12"))
End Sub

Sub CreateWorksheets(Names_Of_Sheets As Range)
Dim Nf_Sheets_to_be_Added As Integer
Dim Sheet_Name As String
Dim i As Integer
Nf_Sheets_to_be_Added = Names_Of_Sheets.Rows.Count
For i = 1 To Nf_Sheets_to_be_Added
Sheet_Name = Names_Of_Sheets.Cells(i, 1).Value
'Only add sheet if it doesn't exist already and the name is longer than zero characters
If (Sheet_Exists(Sheet_Name) = False) And (Sheet_Name <> "") Then
Worksheets.Add().Name = Sheet_Name

Sheets("sample detail sheet").Select
' Cells.Select
Selection.Copy
Sheets("wergvrw").Select
' Cells.Select
ActiveSheet.Paste
Range("B2").Select

End If
Next i
End Sub

Function Sheet_Exists(WorkSheet_Name As String) As Boolean
Dim Work_sheet As Worksheet
Sheet_Exists = False
For Each Work_sheet In ThisWorkbook.Worksheets
If Work_sheet.Name = WorkSheet_Name Then
Sheet_Exists = True
End If
Next
End Function

The stuff in purple is the end of the road for me; My VBA runs out here. I really need help from a more experienced practitioner or I'm never gonna manage to deliver. Any assistance welcomed.

 

[jbeaucaire]

This will take care of it:

Option Explicit

Sub PointStar1_Click()
    Call CreateWorksheets(Sheets("Top Level").Range("C4:C12"))
    Me.Activate
End Sub

Sub CreateWorksheets(Names_Of_Sheets As Range)
Dim Sheet_Name As Range

    For Each Sheet_Name In Names_Of_Sheets
        If Len(Sheet_Name.Value) > 0 Then
            If Not Evaluate("ISREF('" & Sheet_Name.Value & "'!A1)") Then
                Sheets("Sample Detail Sheet").Copy after:=Sheets(Sheets.Count)
                ActiveSheet.Name = Sheet_Name.Value
            End If
        End If
    Next Sheet_Name

End Sub

The ISREF() trick is a simple worksheet formula that looks to see if cell A1 can be found on a sheet called Sheet_Name. It's a cool oneliner for determining if a sheet exists or not.

 

[tbablue]

absolutely awesome jbeaucaire - thanks for solving a problem that was beginning to drive me crazy.

Appreciated!

 

[jbeaucaire]

If you want to eliminate the "flicker", then do this:

Sub PointStar1_Click()
    Application.ScreenUpdating = False
    Call CreateWorksheets(Sheets("Top Level").Range("C4:C12"))
    Me.Activate
    Application.ScreenUpdating = True
End Sub