简体   繁体   中英

Excel: VBA create worksheets without duplicates

I've been trying to create a macros for creating worksheets. The code should do the following:

1) Create worksheets for ColumnB from Master sheet, using template from "Template" worksheet.

2) The range of ColumnB in Master sheet is variable, but this is my first try with excel-vba, and I don't know how to set a variable range.

3) Rename each worksheet as per the name in each cell in ColumnB

3.1) ColumnB has duplicate entries, but we need to create only 1 worksheet for duplicate cells. (deleting duplicates is not an option)

4)Hyperlink the worksheets to the cells in the Column B of Master sheet.

I am facing issues with the point 3.1 mentioned above. Below is the closest thing I found useful: Can we refine it to my requirements?

Sub CreateAndNameWorksheets()
    Dim c As Range

    Application.ScreenUpdating = False
        For Each c In Sheets("Master").Range("B5:B25000")
        Sheets("Template").Copy After:=Sheets(Sheets.Count)
        With c
            ActiveSheet.Name = .Value
            .Parent.Hyperlinks.Add Anchor:=c, Address:="", SubAddress:= _
                "'" & .Text & "'!A1", TextToDisplay:=.Text
        End With
    Next c
    Application.ScreenUpdating = True

End Sub

Thank you!

Solution explanation:
While the SheetExists is a neat approximation to solve the issue stated, the real solution would be more complicated than that
Solution:
The Sub Duplicate_Template will help you to do so. And is easier to call it whenever you need to do the same operation (I call this "mirror functions").

Sub Duplicate_Template(TemplateToDuplicate As String, NameNewSheet As String)
    If SheetExists(NameNewSheet) = False Then
    Sheets(TemplateToDuplicate).Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = NameNewSheet
    End If
End Sub
 Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
    Dim sht As Worksheet
     If wb Is Nothing Then Set wb = ThisWorkbook
     On Error Resume Next
     Set sht = wb.Sheets(shtName)
     On Error GoTo 0
     SheetExists = Not sht Is Nothing
 End Function

A generic set of functions to create non-duplicate sheets:

You can use the Cell.Values from column B as the strings to test

Sub Test()
    Call CreateNonDupeWS("Test1")
    Call CreateNonDupeWS("Test2", "Test1")
    Call CreateNonDupeWS("Test3", "Test1")
    Call CreateNonDupeWS("Test1")
End Sub

Private Function CreateNonDupeWS(wsNew As String, Optional wsAfter As String) As Boolean
On Error GoTo ExitSub
    If IsMissing(wsAfter) Then wsAfter = Sheets(Sheets.Count).Name
    If Not WorkSheetExists(wsNew) Then Worksheets.Add().Name = wsNew
    If WorkSheetExists(wsAfter) Then Worksheets(wsNew).Move After:=Worksheets(wsAfter)
    CreateNonDupeWS = True
ExitSub:
End Function

Function WorkSheetExists(ByVal sName As String) As Boolean
   On Error Resume Next
   WorkSheetExists = Not ActiveWorkbook.Worksheets(sName) Is Nothing
End Function

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM