Forum Discussion

JoeCavasin's avatar
JoeCavasin
Brass Contributor
Aug 30, 2022
Solved

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

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".

 

 

 

 

Macros and VBA
  • HansVogelaar's avatar
    HansVogelaar
    Aug 31, 2022

    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 Replies

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Aug 30, 2022

    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...

    • JoeCavasin's avatar
      JoeCavasin
      Brass Contributor
      Aug 30, 2022

      HansVogelaar - 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

      • HansVogelaar's avatar
        HansVogelaar
        MVP
        Aug 31, 2022

        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

Resources