Forum Discussion

JoeCavasin's avatar
JoeCavasin
Brass Contributor
Nov 16, 2023

HansVogelaar stupid question time.  It seems it works beautifully if i only have 1 new user to add. If i have more than one it behaves oddly, and errors on creating the second new user sheet. Behavior is as follows:
1. First new sheet created, cell b8 named, sheet named, and all un needed rows removed.
2. Next copy of "Template" created, but cell B8 is named the name of the sheet created in bullet 1. at the point the WSN.Name fires again, the macro errors, advising, best as i can translate, the sheet name is already taken by the previously created tab.

Hope that makes sense, and can be recreated with the copy i'm attaching here. Again, this logic you had above, is now labelled the CreateNewV2.

HansVogelaar's avatar
HansVogelaar
MVP
Nov 17, 2023

JoeCavasin 

I had to move three lines into the Do ... Loop.

Sub CreateNewUserTabCCCCCV2()
    Dim WBK As Workbook
    Dim WSH As Worksheet
    Dim RNG1 As Range
    Dim RNG2 As Range
    Dim ADR1 As String
    Dim ADR2 As String
    Dim WSN As Worksheet
    Dim ID As Long
    Dim RowStart As String
    Dim RowEnd As String
    Dim EndAddress As String
    Dim StartAddress As String
    Dim StartMonth As String
    Dim StartRow As String
    Dim LR As Long

'Save and close 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
    Application.ScreenUpdating = False
    Set WBK = ThisWorkbook
    Set WSH = WBK.Worksheets("User List")
    With WSH.Range("F:F")
        Set RNG1 = .Find(What:="No", LookIn:=xlValues, Lookat:=xlWhole)
        If Not RNG1 Is Nothing Then
            Do
                ADR1 = RNG1.Address
                Set RNG2 = RNG1.Offset(0, -5)
                ADR2 = RNG2.Address
                If RNG2.Value <> "" Then
                    ID = RNG2.Value
                    StartMonth = RNG1.Offset(0, 1).Value
            'Copy template to end of sheets
                    WBK.Worksheets("Template").Copy After:=WBK.Worksheets(WBK.Worksheets.Count)
                    Set WSN = WBK.Worksheets(WBK.Worksheets.Count)
            'Update ID Cell and Tab Name on new sheet
                    WSN.Range("B8").Value = ID
                    WSN.Name = CStr(ID)
            'Identify future month rows to remove
                    WSN.Range("A11") = RowStart
                    EndAddress = WSN.Cells(WorksheetFunction.Match(StartMonth, WSN.Range("A:A"), 0), 1).Address
                    RowEnd = WSN.Range(EndAddress).Row
                    WSN.Range("A11:A" & RowEnd - 1).EntireRow.Delete
            'Identify pre-start month rows to remove
                    StartAddress = WSN.Cells(WorksheetFunction.Match(StartMonth, WSN.Range("A:A"), 0), 1).Address
                    RowStart = WSN.Range(StartAddress).Row
                    LR = WSN.Cells(WSN.Rows.Count, 1).End(xlUp).Row
                    WSN.Range("A" & RowStart + 1 & ":A" & LR).EntireRow.Delete
            'Update New Sheet Caluclation References
                    WSN.Range("B9").Formula = "=SUM($AL$11:$AL$33)"
                    WSN.Range("G9").Formula = "=SUM($AO$11:$AO$33)"
                    WSN.Range("J9").Formula = "=SUM($AM$11:$AM$33)"
                    WSN.Range("N9").Formula = "=SUM($AN$11:$AN$33)"
                    WSN.Range("Q9").Formula = "=SUM($AK$11:$AK$21)"
                    WSN.Range("T9").Formula = "=SUM($AI$11:$AI$33)"
                    WSN.Range("Y9").Formula = "=SUM($AH$11:$AH$33)"
                    WSN.Range("AB9").Formula = "=SUM($AJ$11:$AJ$33)"
                    WSN.Range("B1").Formula = "=B9"
                    WSN.Range("B3").Formula = "=SUM(G9,J9,N9)"
                    WSN.Range("B5").Formula = "=Q9"
            'Update User List to create links to newly created user tabs
                    WSH.Hyperlinks.Add Anchor:=RNG2, Address:="", SubAddress:="'" & WSN.Name & "'!A1"
                End If
                RNG1.Value = "Yes"
                Set RNG1 = .Find(What:="No", After:=RNG1, Lookat:=xlWhole)
                If RNG1 Is Nothing Then Exit Do
            Loop Until RNG1.Address = ADR1
        End If
    End With
    WSH.Activate
    Application.ScreenUpdating = True
End Sub

Resources