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.