Results 1 to 2 of 2

Thread: Create Or Update A Hyperlink Index Of Visible Sheets

  1. #1
    Member
    Join Date
    Jul 2013
    Posts
    40
    Rep Power
    0

    Create Or Update A Hyperlink Index Of Visible Sheets

    Place the code below in a standard module and run Indexing Sub so as to create or update a hyperlink index of all visible sheets in a new sheet called INDEX.
    Also a "Back to index" will be added to the top of each visible sheet by inserting rows so to avoid deleting existing data.

    enjoy

    Code:
    Dim wSheet As Worksheet, mySht As Worksheet
    Dim l As Long
    
    Sub Indexing()
    
    RESPONSE = MsgBox("Select 'Yes' to create an index or 'No' to refresh the existing one. Select 'Cancel' to abort.", vbYesNoCancel)
    
    If RESPONSE = vbYes Then
    Call Generate_Index
    MsgBox "Index created"
    ElseIf RESPONSE = vbNo Then
    Call Refresh_Index
    MsgBox "Index updated"
    Else
    MsgBox "Operation cancelled"
    End If
    
    End Sub
    
    
    Sub Refresh_Index()
        
    With Application
        .ScreenUpdating = False
        .Cursor = xlWait
    End With
        
        l = 1
        Set mySht = Sheets("INDEX")
        With mySht
            .Columns(1).ClearContents
            .Cells(1, 1) = "INDEX"
            .Cells(1, 1).name = "Index"
            .Cells(1, 1).font.Bold = True
            .Cells(1, 1).Interior.Color = 12859158
            .Cells(1, 1).font.ThemeColor = xlThemeColorDark1
        End With
    
    
        For Each wSheet In Worksheets
    
            If wSheet.Visible = True And wSheet.name <> "INDEX" And wSheet.Range("A1").Text = "Back to Index" Then
                       
                l = l + 1
                    With wSheet
                        .Range("A1").name = "Start_" & wSheet.INDEX
                        .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                        SubAddress:="Index", TextToDisplay:="Back to Index"
                        .Range("A1").EntireColumn.AutoFit
                    End With
                    mySht.Hyperlinks.Add Anchor:=mySht.Cells(l, 1), Address:="", _
                    SubAddress:="Start_" & wSheet.INDEX, TextToDisplay:=wSheet.name
                    
            ElseIf wSheet.Visible = True And wSheet.name <> "INDEX" Then
                    
                    wSheet.Select
                    Rows("1:1").Select
                    For i = 1 To 2
                    Selection.Insert Shift:=xlDown
                    Next i
                    Range("A1").Select
                    
                 l = l + 1
                    With wSheet
                        .Range("A1").name = "Start_" & wSheet.INDEX
                        .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                        SubAddress:="Index", TextToDisplay:="Back to Index"
                        .Range("A1").EntireColumn.AutoFit
                    End With
                    mySht.Hyperlinks.Add Anchor:=mySht.Cells(l, 1), Address:="", _
                    SubAddress:="Start_" & wSheet.INDEX, TextToDisplay:=wSheet.name
                   
                    
            End If
        Next wSheet
        
        mySht.Select
    
    With Application
        .ScreenUpdating = True
        .Cursor = xlDefault
    End With
    
    End Sub
    
    Sub Generate_Index()
    
    With Application
        .ScreenUpdating = False
        .Cursor = xlWait
    End With
    
        l = 1
        Worksheets.Add(Before:=Worksheets(1)).name = "INDEX"
        Set mySht = Sheets("INDEX")
        With mySht
            .Columns(1).ClearContents
            .Cells(1, 1) = "INDEX"
            .Cells(1, 1).name = "Index"
            .Cells(1, 1).font.Bold = True
            .Cells(1, 1).Interior.Color = 12859158
            .Cells(1, 1).font.ThemeColor = xlThemeColorDark1
        End With
    
        For Each wSheet In Worksheets
    
            If wSheet.Visible = True And wSheet.name <> "INDEX" Then
                    wSheet.Select
                    Rows("1:1").Select
                    For i = 1 To 2
                    Selection.Insert Shift:=xlDown
                    Next i
                    Range("A1").Select
                    
                l = l + 1
                    With wSheet
                        .Range("A1").name = "Start_" & wSheet.INDEX
                        .Hyperlinks.Add Anchor:=.Range("A1"), Address:="", _
                        SubAddress:="Index", TextToDisplay:="Back to Index"
                        .Range("A1").EntireColumn.AutoFit
                    End With
                    mySht.Hyperlinks.Add Anchor:=mySht.Cells(l, 1), Address:="", _
                    SubAddress:="Start_" & wSheet.INDEX, TextToDisplay:=wSheet.name
            End If
        Next wSheet
        
        mySht.Select
        
    With Application
        .ScreenUpdating = True
        .Cursor = xlDefault
    End With
    End Sub
    Keep in mind all vba I know has been googled...

  2. #2
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,122
    Rep Power
    10
    Thanks for sharing Keep posting
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

Similar Threads

  1. vba, worksheet visible issue
    By xander1981 in forum Excel Help
    Replies: 1
    Last Post: 03-13-2014, 04:06 PM
  2. Create folder and copy 2 sheets
    By Conan in forum Excel Help
    Replies: 10
    Last Post: 09-18-2013, 07:21 PM
  3. Replies: 4
    Last Post: 05-05-2013, 04:01 AM
  4. Index Sheets with Shapes and Hyperlink
    By TomyLee in forum Excel Help
    Replies: 9
    Last Post: 09-04-2012, 10:52 PM
  5. Replies: 7
    Last Post: 06-09-2012, 06:45 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •