auto generation of worsheets (or renaming tab names)

Brooks70459

New Member
Joined
Jun 25, 2009
Messages
43
I would like to either auto create or edit names of worksheets in a workbook based on values (names) contained in a column on the first worksheet.

I am using the first sheet in a workbook as an index. This is an index of ten subsequent worksheets. (there will be many more actually created)

At a minimum, On the index sheet I have a list of sub assemlies begining in b2 thru b10. These will be the tab names I need to auto create.

If this works, then I would like to extend the complexity of the function where, I would like to parse the values column test the values in an exisitng worksheet tab.

I would like the function to go down a list and rename the existing tabs based on the values found on the list, then delete all extra tabs right of the last tab evaluated by the list.

Lastly, if this works(a challenge :eek:) , I would like to autocreate hyperlinks, connecting the values index to their respective tab. (wishful thinking I'll bet :rolleyes:.)
 

Some videos you may like

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,378
Try something like this...

Code:
Sub Create_TOC()

    ' Table Of Contents macro.
    
    Dim wsTOC As Worksheet, rTOC As Range, wsNDx As Worksheet
    Dim cell As Range, counter As Integer
    
    Set wsTOC = ActiveSheet
    Set rTOC = wsTOC.Range([COLOR="Red"]"B2:B10"[/COLOR])
    counter = 1
    
    Application.ScreenUpdating = False
    
    For Each cell In rTOC
    
        Set wsNDx = Nothing
        On Error Resume Next
            Set wsNDx = Sheets(cell.Value)
        On Error GoTo 0
        If wsNDx Is Nothing Then
            Set wsNDx = Worksheets.Add(After:=Sheets(counter))
            wsNDx.Name = cell.Value
        End If
        
        wsNDx.Move After:=Sheets(cntr)
        cell.Hyperlinks.Add Anchor:=cell, Address:="", SubAddress:=wsNDx.Name & "!A1", TextToDisplay:=cell.Value
        counter = counter + 1
        
    Next cell

    If Sheets.Count > counter Then
        Application.DisplayAlerts = False
        For i = Sheets.Count To counter Step -1
            Sheets(i).Delete
        Next i
        Application.DisplayAlerts = True
    End If
    
    wsTOC.Select
    
    Application.ScreenUpdating = True
    
End Sub
 

pboltonchina

Well-known Member
Joined
Apr 24, 2008
Messages
1,095
This will rename your sheets from a list in column A
Code:
Sub RenSht()
'renames sheets from a list in column A
Dim i As Long
With ActiveWorkbook
For i = 1 To Worksheets.Count - 1
    Worksheets(i).Name = Worksheets(Worksheets.Count).Range("A" & i).Value
Next i
End With

End Sub
 

Brooks70459

New Member
Joined
Jun 25, 2009
Messages
43
It kinda worked; the first worksheet was created with the correct name but that was it. I played with the range in the macro code a bit but continued to get out of range errors.

Then it occured to me that I actually need to create the first worksheet (with all of its code) as a template and duplicate that as the worksheets created off of the TOC.




Try something like this...

Code:
Sub Create_TOC()
 
    ' Table Of Contents macro.
 
    Dim wsTOC As Worksheet, rTOC As Range, wsNDx As Worksheet
    Dim cell As Range, counter As Integer
 
    Set wsTOC = ActiveSheet
    Set rTOC = wsTOC.Range([COLOR=red]"B2:B10"[/COLOR])
    counter = 1
 
    Application.ScreenUpdating = False
 
    For Each cell In rTOC
 
        Set wsNDx = Nothing
        On Error Resume Next
            Set wsNDx = Sheets(cell.Value)
        On Error GoTo 0
        If wsNDx Is Nothing Then
            Set wsNDx = Worksheets.Add(After:=Sheets(counter))
            wsNDx.Name = cell.Value
        End If
 
        wsNDx.Move After:=Sheets(cntr)
        cell.Hyperlinks.Add Anchor:=cell, Address:="", SubAddress:=wsNDx.Name & "!A1", TextToDisplay:=cell.Value
        counter = counter + 1
 
    Next cell
 
    If Sheets.Count > counter Then
        Application.DisplayAlerts = False
        For i = Sheets.Count To counter Step -1
            Sheets(i).Delete
        Next i
        Application.DisplayAlerts = True
    End If
 
    wsTOC.Select
 
    Application.ScreenUpdating = True
 
End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,122,553
Messages
5,596,807
Members
414,104
Latest member
imamalidadashzada

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top