Excel VBA Copy Template Worksheet and rename based on specific cells/update values of specific cells

[JoeCavasin]

In the attached dummy file, needing help with one final (hopefully) macro.  Ideally, the macro can look at Prod Assembly sheet, cell A1.  If A1 <> 0, then make the number of copies (of "Template" sheet) indicated by the value in A1.   The new duplicated sheets will reside in the existing workbook.  Each new sheet will be updated both on the Sheet name and cell B2 as the employee ID. 

I have three other solidly functioning macros stored in this workbook (thanks @HansVolegaar!), the new to be macro is currently titled "ModCreateNewUserTab".

[#2]

@JoeCavasin 

I don't quite understand.

If you enter - for example - 10 in A1, what should we use as sheet names? The IDs in B3:B5 have already been used, and B7 and down are empty...

[#3]

@Hans Vogelaar - no worries, hopefully this clarifies:

The number in A1 is the output of a CountIF formula checking the number of times the word "no" results in column A3:A...  All the cells in column A from row 3 down do a check against the employee number to the tabs names present in the sheet.  If the tab name is not found by the formula in A#, then the formula returns "No", indicating this is a newly added employee.  

The Macro can utilize either "No" or the number of no's (counted in A1) to power the number of copies of the template to make...  The current user sheets are: 123456, 234567, 345678.   The new user id is 456789, and should have "no" in column A, as well as not have a worksheet named 456789.

Thanks

Joe

[#4 · Accepted solution]

@JoeCavasin 

Thanks. Here you go:

Dim WBK As Workbook
Dim WSH As Worksheet
Dim RNG As Range
Dim ADR As String
Dim WSN As Worksheet
Dim ID As Long

'Close and save other workbooks
'    For Each WBK In Application.Workbooks
'        If Not (WBK Is Application.ThisWorkbook) Then
'            WBK.Close SaveChanges:=True
'        End If
'    Next WBK
'Find New Users on Productivity Tab
    Set WBK = ThisWorkbook
    Set WSH = WBK.Worksheets("Prod Assembly")
    With WSH.Range("A:A")
        Set RNG = .Find(What:="No", LookIn:=xlValues, LookAt:=xlWhole)
        If Not RNG Is Nothing Then
            ADR = RNG.Address
            Do
                If RNG.Offset(0, 1).Value <> "" Then
                    ID = RNG.Offset(0, 1).Value
                    WBK.Worksheets("Template").Copy After:=WBK.Worksheets(WBK.Worksheets.Count)
                    Set WSN = WBK.Worksheets(WBK.Worksheets.Count)
                    WSN.Range("B2").Value = ID
                    WSN.Name = CStr(ID)
                End If
                Set RNG = .Find(What:="No", LookAt:=xlWhole)
                If RNG Is Nothing Then Exit Do
            Loop Until RNG.Address = ADR
        End If
    End With
    WSH.Activate
End Sub

[#5]

@Hans Vogelaar 

Can't thank you enough!  I made a few small tweaks to help with some other tabs that will  have to exist in the real world version.  Only problem now is on running the "Clear User Sheets" macro, it performs perfectly, skipping all other sheets - however it is throwing the "False" error message box at completion.  

Do you mind checking it out?  I can't figure out what is triggering a "false" response.

[#6]

@JoeCavasin 

The line

MsgBox sTemp = "Refreshed Scoring Template and Formulas for the following worksheets"

Displays the result of evaluating the expression

sTemp = "Refreshed Scoring Template and Formulas for the following worksheets"

Since sTemp is an empty string, the expression is not true, so MsgBox displays False. You don't need sTemp at all here, simply use

MsgBox "Refreshed Scoring Template and Formulas for the following worksheets"