This Excel page deals mainly with Hyperlinks and documentationCreate a Table of Contents list complete with hyperlinks in XL97 and up, as well as considerations in a similar listing for XL95 without hyperlinks.  Displaying hyperlinks, creating hyperlinks from clipboard.  List all Subroutines and Functions in all Open workbooks showing duplicates etc.  Additional information for creating Excel documentation.  My pages tend to be long but they are HTML text with very few graphics so should load fast.  Macros dealing with hyperlinks are on this page, but additional sheet related hyperlinks material is on a page related to sheets

Build Table of Contents, similar listings, working with Hyperlinks

Location:http://dmcritchie.www.mvps.org/excel/buildtoc.htm
Code:Coding within this page at /code/buildtoc.txt
Home page: excel/excel.htm
[View without Frames]
[buildtoc], [sortallsheets], [hyperlinks], [hyp], [large], [buildtoc_a3], [SheetnamesInA1], [loopWB], [trevor001], [across], [GoToSub], [RunSubFromActiveCell], [GoToSheet], [TopLeft], [showtopleft], [ListFunctionsAndSubs], [dup_refs], [addins], [EnumerateSheets_XL95], [GetAllA1Cells], [hyp], [snippets], [CtrlK], [avoiding], [URL], [Hyperlinkaddress], [GetHyperlink], [Bookmarklets], [DelHyperlinks], [preventhyp], [ConvertHyperlinks], [GoToHTML], [HyperlinkStyle], [MakeTextOnlyFromHyperlinks], [hyperlink], [MakeHyperlinks], [MakeEmailLinks], [FixHyperlinks], [MakeHyperlinkFormulas], [AltF8], [forcelinks], [GoToHyperlink], [xlOpensWord], [navigatewithin], [navigate], [GoToSheet], [allworksheets], [hyperlink], [bookmark], [recentuse], [RemoveCRLF], [alternatives], [Menus], [MenuCoding], [MenuLinks], [outline], [PageNumbers], [related], [docinfo], [match example (VLOOKUP)],
Some of the fragment id's above have been changed to lowercase from mixedcase for fussy browsers, even if you can't read them properly, so double check reference before posting.

Several topics on this page contain or refer to some VBA macros and to User Defined Functions.  If you need assistance to install macros or UDFs please refer to my  «Getting Started with Macros« or delve into it deeper on my Install  page.

Coding

The coding seen or described on this page can be cut and pasted directly from the following locations:
Coding for macros BuildTOC, SortAllSheets, DelHyperlinks, MakeHyperLinks, RunSubFromActiveCell, LinkFixLinkFix_GoToMakeHTML_Link
and the user defined functions URL and MSKBQ can be found at
    http://dmcritchie.mvps.org/excel/code/buildtoc.txt

Separate coding for ListFunctionsAndSubs can be found at
   http://dmcritchie.mvps.org/excel/code/listfsubs.txt
   See internal note concerning “Microsoft Visual Basic For Application Extensibility” required in the VBE

and the macros GoToCell, GoToHyperlink, GoToSheet, Next Sheet GoToNextSheet, Next Sheet GoToPrevSheet,
    GoToSub GoToSub, ShowTopLeft
and ShowTopLeft5. can be found at
    http://dmcritchie.mvps.org/excel/code/gotostuff.txt   also see Toolbar and Menu examples on Toolbars page.

BuildTOC

Creating a Table of Contents with hyperlinks to the sheets in the workbook is simple using the BuildTOC() macro.  XL2000 provides hypertext links in your Excel spreadsheets.  The links generated here will be to sheets within your workbook.

Included are Worksheet, Module, and Dialog which will be sorted descending so that the worksheets appear first.  Sheet Tabs on the other hand are sorted without regard to type, do not include modules, and the collating sequence is slightly different for special characters such as a tilde (~).

If all you want to do is to sort the worksheet tabs then skip down to SortAllSheets, which is optionally invoked by Build Table of Contents.

 

 ABCD
1   Select a3 and create or
   redo with BuildTOC()
 
2 Worksheet Type CodeName  
3 $$TOC Worksheet Sheet94  
4 ~HELP~ Worksheet Sheet85  
5 1999-01-31 Worksheet Sheet6  
6 1999-04-04 Worksheet Sheet7  
7 1999-06-15 Worksheet Sheet1  
8 1st 2nd 3rd Worksheet Sheet8  
9 4hdr rows Worksheet Sheet9  
11 Abuse Worksheet Sheet10  
12 AddinsSheet Worksheet Sheet11  
13 Address Worksheet Sheet12  
     

Referencing a Worksheet (#sheets)

Referencing the Worksheet name seen on the tabs at the bottom
 
Worksheets("Sheet3").Select
Sheets("Sheet3").Select
 
Referencing the sheet name (code name) that is located in the sheets properties (in the Properties window) in VBE.
 
Sheet3.Select
Sheet(3).Select
 
Referencing the sheet name as the activesheet
ActiveSheet.Range("A1").Value = 99
 
The Table shown on the left is typical of the generated results from the BuildTOC described on this page.

Although this page is really mainly about hyperlinks.  You might find the following formula version interesting.  You would see nothing, A5 or A8 which would correspond to no link, link to A5 or link to A8 all depending on value in A1.  This is all one long worksheet formula, no spaces needed...

=IF(TRIM(A1)="","",IF(A1<5,HYPERLINK("[vlookup.xls]Sheet31!A5","a5"),HYPERLINK("[vlookup.xls]Sheet31!A8","a8")))

The above Table will be redone in the following format

Lastcell problems where something has caused there to be a lot more rows or columns than there should be are a nuisance.  This additional information can be easily collected here; whereas, navigation within a spreadsheet containing protected cells, and restricted scrolling areas can make manual checking for lastcell very difficult.  Future enhancement may include attributes: hidden, protected, passworded, and additional items: # sheet macros present, number of formulas, number of constants. (2000-09-06)

 ABCDEFG
1 Select A3 and create or redo with BuildTOC()
2WorksheetType CodeNamelastcellcells scrollareaPrintarea
3ContractorsWorksheet Sheet5T1683,360  $A$1:$I$168
4InsulationWorksheet Sheet2Y1393,475   
5IntroductionWorksheet Sheet12CL94685,140   
6MisbehavingWorksheet Sheet20M65536 851,968   
7ReportingWorksheet Sheet8AQ813,483  $S$1:$AQ$59
8RequirementsWorksheet Sheet9AL933,534   
9Sheet1Worksheet Sheet32AP592,478   
10Sub ContractWorksheet Sheet11AL933,534  $A$1:$S$132
11Suppliers - ALLWorksheet Sheet7AC241169,919   
12Suppliers - MajorWorksheet Sheet10AL933,534  $1:$65536
13Vendor ListWorksheet Sheet6AX109454,700$A1:M79 $A$1:$Q$79

Also have an auxiliary page on how to Build a Summary Sheet for sheets that have exactly the same consistent format.

Coding for BuildTOC() macro (#buildtoc)

I have changed the name of the macro from EnumerateSheets to BuildTOC which should be more descriptive of its usage and matches the name of the webpage.  Because of the potential to destroy a large area in a spreadsheet some precautions have been implemented intended to reduce mistakes, including: Check that sheetname is $$TOC, and that the selected cell is either blank or has a value of $$TOC, anything else gets a warning.

If you need instructions to install a macro see my formula page.

Update - update - update - update - update - update - update - update - update - update - update - update.
 

This macro has been redesigned to work in XL95, XL97, and XL2000. 
In XL95 you cannot use hyperlinks but you can use the GoToSheet subroutine included.

Chip Pearson has noted in a newsgroup posting that having more than a couple of dozen hyperlinks of the object kind can have a devastating effect on workbook performance.  So the BuildTOC macro has been changed to create the =HYPERLINK(target,description) type instead of object hyperlinks.  Also note that the object hyperlinks can be removed with DelHyperlinks() macro described on this web page.
 
Update - update - update - update - update - update - update - update - update - update - update - update.

Sub BuildTOC()
  'listed from active cell down 7-cols --  DMcRitchie 1999-08-14 2000-09-05
  Dim iSheet As Long, iBefore As Long
  Dim sSheetName As String, sActiveCell As String
  Dim cRow As Long, cCol As Long, cSht As Long
  Dim lastcell
  Dim qSht As String
  Dim mg As String
  Dim rg As Range
  Dim CRLF As String
  Dim Reply As Variant
  Application.Calculation = xlCalculationManual
  Application.ScreenUpdating = False
  cRow = ActiveCell.Row
  cCol = ActiveCell.Column
  sSheetName = UCase(ActiveSheet.Name)
  sActiveCell = UCase(ActiveCell.Value)
  mg = ""
  CRLF = Chr(10)  'Actually just CR
  Set rg = Range(Cells(cRow, cCol), Cells(cRow - 1 + ActiveWorkbook.Sheets.Count, cCol + 7))
  rg.Select
  If sSheetName <> "$$TOC" Then mg = mg & "Sheetname is not $$TOC" & CRLF
  If sActiveCell <> "$$TOC" Then mg = mg & "Selected cell value is not $$TOC" & CRLF
  If mg <> "" Then
     mg = "Warning BuildTOC will destructively rewrite the selected area" _
     & CRLF & CRLF & mg & CRLF & "Press OK to proceed, " _
      & "the affected area will be rewritten, or" & CRLF & _
      "Press CANCEL to check area then reinvoke this macro (BuildTOC)"
     Application.ScreenUpdating = True  'make range visible
     Reply = MsgBox(mg, vbOKCancel, "Create TOC for " & ActiveWorkbook.Sheets.Count _
      & " items in workbook" & Chr(10) & "revised will now occupy up to 10 columns")
     Application.ScreenUpdating = False
     If Reply <> 1 Then GoTo AbortCode
  End If
  rg.Clear      'Clear out any previous hyperlinks, fonts, etc in the area
  For cSht = 1 To ActiveWorkbook.Sheets.Count
     Cells(cRow - 1 + cSht, cCol) = "'" & Sheets(cSht).Name
     If TypeName(Sheets(cSht)) = "Worksheet" Then
        'hypName = "'" & Sheets(csht).Name
        ' qSht = Replace(Sheets(cSht).Name, """", """""") -- replace not in XL97
        qSht = Application.Substitute(Sheets(cSht).Name, """", """""")
        If CDbl(Application.Version) <  8.0  Then
          '-- use next line for XL95
          Cells(cRow - 1 + cSht, cCol + 2) = "'" & Sheets(cSht).Name  'XL95
        Else
          '-- Only for XL97, XL98, XL2000 -- will create hyperlink & codename
          Cells(cRow - 1 + cSht, cCol + 2) = "'" & Sheets(cSht).CodeName

          '--- excel is not handling lots of objects well ---
          'ActiveSheet.Hyperlinks.Add Anchor:=Cells(cRow - 1 + cSht, cCol), _
          '  Address:="", SubAddress:="'" & Sheets(cSht).Name & "'!A1"
          '--- so will use the HYPERLINK formula instead ---
          '--- =HYPERLINK("[VLOOKUP.XLS]'$$TOC'!A1","$$TOC")
          ActiveSheet.Cells(cRow - 1 + cSht, cCol).Formula = _
            "=hyperlink(""[" & ActiveWorkbook.Name _
            & "]'" & qSht & "'!A1"",""" & qSht & """)"
        End If
     Else
       Cells(cRow - 1 + cSht, cCol + 2) = "'" & Sheets(cSht).Name
     End If
     Cells(cRow - 1 + cSht, cCol + 1) = TypeName(Sheets(cSht))
    ' -- activate next line to include content of cell A1 for each sheet
    ' Cells(cRow - 1 + csht, cCol + 3) = Sheets(Sheets(csht).Name).Range("A1").Value
     On Error Resume Next
     Cells(cRow - 1 + cSht, cCol + 6) = Sheets(cSht).ScrollArea '.Address(0, 0)
     Cells(cRow - 1 + cSht, cCol + 7) = Sheets(cSht).PageSetup.PrintArea
     If TypeName(Sheets(cSht)) <> "Worksheet" Then GoTo byp7
     Set lastcell = Sheets(cSht).Cells.SpecialCells(xlLastCell)
     Cells(cRow - 1 + cSht, cCol + 4) = lastcell.Address(0, 0)
     Cells(cRow - 1 + cSht, cCol + 5) = lastcell.Column * lastcell.Row
byp7: 'xxx
     On Error GoTo 0
  Next cSht

  'Now sort the results:  2. Type(D), 1. Name (A), 3. module(unsorted)
  rg.Sort Key1:=rg.Cells(1, 2), Order1:=xlDescending, Key2:=rg.Cells(1, 1) _
      , Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
      Orientation:=xlTopToBottom
  rg.Columns.AutoFit
  rg.Select           'optional
  'if cells above range are blank want these headers
  ' Worksheet,   Type,    codename
  If cRow > 1 Then
     If "" = Trim(Cells(cRow - 1, cCol) & Cells(cRow - 1, cCol + 1) & Cells(cRow - 1, cCol + 2)) Then
        Cells(cRow - 1, cCol) = "Worksheet"
        Cells(cRow - 1, cCol + 1) = "Type"
        Cells(cRow - 1, cCol + 2) = "CodeName"
        Cells(cRow - 1, cCol + 3) = "[opt.]"
        Cells(cRow - 1, cCol + 4) = "Lastcell"
        Cells(cRow - 1, cCol + 5) = "cells"
        Cells(cRow - 1, cCol + 6) = "ScrollArea"
        Cells(cRow - 1, cCol + 7) = "PrintArea"
     End If
  End If
  Application.ScreenUpdating = True
  Reply = MsgBox("Table of Contents created." & CRLF & CRLF & _
     "Would you like the tabs in workbook also sorted", _
     vbOKCancel, "Option to Sort " & ActiveWorkbook.Sheets.Count _
     & " tabs in workbook")
  Application.ScreenUpdating = False
  If Reply = 1 Then SortALLSheets  'Invoke macro to Sort Sheet Tabs
  Sheets(sSheetName).Activate
AbortCode:
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
End Sub
Sub BuildTOC_A3()
   Cells(3, 1).Select
   BuildTOC
End Sub

SortAllSheets -- The following code will sort sheet tabs (#sortallsheets)

The following code will perform an alphabetical sort of sheet tabs and is called from within BuildTOC, so you will want to incorporate the following code or something similar.  Within the similar sorts is one to sort by type then by name.  Chip Pearson on his sortws.htm includes ability to sort within grouped sheets, and by worksheet tab color color tabs introduced in Excel 2002).  See the SheetList_CP macro for a means to bring up the “More Sheets” dialog box directly.

Please name worksheets with sorting in mind.  Name a dated worksheet as yyyy-mm-dd to keep out of trouble instead of mm-dd-yy or mmm-dd.  Use yyyy_mmdd if you want it a little shorter.  ActiveSheet.Name = Format(Date, "yyyy-mm-dd")  This principal applies to naming files that have dates in their filenames such as a backup filename.

You can enhance your sorted arrangement by preceding the sheet tab with some less conspicuous small letters, and that is a lot better than colored sheet tabs — i.e.   k.FunctKeys, k.ShortCutKeys

There is one problem that I know of with the arrangement of sheet tabs. You will probably have trouble with Mail Merge if the worksheet to be used in Mail Merge is not the first worksheet.

 Install a macro   to Sort All Sheets in a Workbook (rearrange the worksheet tabs)
Sub SortALLSheets()
  'sort sheets within a workbook in Excel 7 -- Bill Manville
  'modified to sort all sheets instead of just worksheets
    Dim iSheet As Long, iBefore As Long
  For iSheet = 1 To ActiveWorkbook.Sheets.Count
    Sheets(iSheet).Visible = True
    For iBefore = 1 To iSheet - 1
      If UCase(Sheets(iBefore).Name) > UCase(Sheets(iSheet).Name) Then
        ActiveWorkbook.Sheets(iSheet).Move Before:=ActiveWorkbook.Sheets(iBefore)
        Exit For
      End If
    Next iBefore
  Next iSheet
End Sub
Object links cause problems if you have a lot of them.  Changing from object links to worksheet hyperlinks opens up it’s own can of worms, since the worksheet function requires the workbook name.

If using XL97 or earlier see compatibility notes concerning Replace.

The following suggestion has been made by Dave Peterson (not posted 2001-03-22) who says that renaming the book messes up such references as:
   =HYPERLINK("[VLOOKUP.XLS]'sumproduct'!A1","sumproduct")

Instead of:

       ActiveSheet.Cells(cRow - 1 + cSht, cCol).Formula = _
            "=hyperlink(""[" & ActiveWorkbook.Name _
            & "]'" & qSht & "'!A1"",""" & qSht & """)"
Davd Peterson suggests:
       myformula = MID(CELL(""filename"",$A$1),FIND(""" _
             & "["",CELL(""filename"",$A$1)),FIND(""]""," _
             & "CELL(""filename"",$A$1))-FIND(""[""," _
             & "CELL(""filename"",$A$1))+1)"
      ActiveSheet.Cells(cRow - 1 + vis_sht, cCol).Formula = _
           "=hyperlink(" & myformula & "&""" _
           & "'" & qSht & "'!a1"",""" & qSht & """)"
More on Hyperlinks (#hyp) later on.

Identify Large Sheets in a Workbook (#large)

The BuildTOC macro will identify large sheets based on Rows * Columns in the used range.  If you only want to quickly identify these sheets you can use the QueryLastCells macro found on Last Cell page.

Other Useful/Interesting Information that could be included

Count of number of pages to be printed per worksheet:
  NumPages = ExecuteExcel4Macro("GET.DOCUMENT(50)")

Code to count all print pages from all worksheets & from all open workbooks without activating that worksheets\workbooks. Shailesh Shah, programming, 2002-10-30.

Create a button on the worksheet to invoke BuildTOC (#buildtoc_a3)

< Invoking BuildTOC requires selecting a cell with a hyperlink without taking the link.  Creating a button on the worksheet simplifies this.  First the macro:
Sub BuildTOC_A3()
   Cells(3, 1).Select   'Selects cell A3
   BuildTOC
End Sub
To install the button over a cell with the wording “GoTo/ $$TOC and/ invoke/ BuildTOC”.
  1. Color background of cell with 4 lines shown above.
  2. Ceate picture: select cell, hold Shift + Edit --> Copy picture
  3. Paste with Ctrl+V
  4. With the picture selected, Right-Click --> Format picture --> Properties --> move and size with cells
  5. With the picture selected, Right-Click --> Assign Macro --> BuildTOC_A3

Including Additional Information in Other Columns

Including additional information on you BuildTOC page is not so straightforward.

Each time you run BuildTOC you will rearrange the listing of sheetnames, so if you wanted to include additional information you would need to pull that information in from another sheet or rename of modify the BuildTOC macro.

You could have another sheet and use VLOOKUP, or if the information is in a specific location on the $$TOC indicated sheet use INDIRECT.

You could use INDIRECT and get information off of the indicated sheet.
   =INDIRECT("'"'&A11&"'!A1")   -- single quotes are enclosed in double quotes
The above formula might equate to  ='sheet1'!A1

You could use VLOOKUP to get associated information from another sheet
   =VLOOKUP(A11,table,1,false)   i.e. sheetname in column 1 of table
   =VLOOKUP(A11,table,2,false)   i.e. lastname of person in column 2 of table

False, in VLOOKUP, requires an exact match and the table does not need to be sorted.  You do not want to use true because that will return an exact match or an approximate match.

For more information on VLOOKUP see HELP and my vlookup page
  VLOOKUP Worksheet Function

Looping through all of the worksheets (#SheetnamesInA1)

The following code would place the sheetname of each sheet into cell A1 of it’s own sheet.  Note use worksheets and not sheets, the single quote enclosed in double quotes will insure that the sheetname is placed into the cell as text.
  Sub SheetnamesInA1()
    '2000-04-20
    Dim iSheet as Long
    Application.ScreenUpdating = False
    For iSheet = 1 To ActiveWorkbook.WorkSheets.Count
     WorkSheets(iSheet).cells(1,1) = "'" & WorkSheets(iSheet).name
    Next iSheet
    Application.ScreenUpdating = True
  End Sub

Looping through a set of workbooks listed in a range (#loopWB)

Somewhat off topic on this page, but wanted to point you to some code that obtains values from certain cells from a list of workbooks in column A and places them into a master summary sheet.  Similar in that respect to BuildTOC which can place values from certain cells from the sheets in a workbook into the summary BuildTOC worksheet.  See posting 2002-07-17 by Jim Rech with improvements to Dave Ramage’s solution, and then by BrianB to work from workbook name in Col A, Worksheet name in Col B.  (you can use Dir to list names from a directory.)
Const SrcDir As String = "C:\My Documents\John D 's\"

Sub CopyRoutineForJohn()
    Dim SrcRg As Range
    Dim FileNameCell As Range
    Dim Counter As Long
    Application.ScreenUpdating = False
    Set SrcRg = Range(Range("A3"), Range("A3").End(xlDown))
    On Error GoTo SomethingWrong
    For Each FileNameCell In SrcRg
        Counter = Counter + 1
        Application.StatusBar = "Doing workbook " & _
           Counter & " of " & SrcRg.Cells.Count
        Workbooks.Open SrcDir & FileNameCell.Value
        Range("E1").Copy FileNameCell.Offset(0, 7)
        Range("G39").Copy FileNameCell.Offset(0, 8)
        Range("V39").Copy FileNameCell.Offset(0, 9)
        ActiveWorkbook.Close False
    Next
    Application.StatusBar = False
    Exit Sub
SomethingWrong:
    MsgBox "Could not process " & FileNameCell.Value
End Sub

Other directory things

Converting a selection containing sheetnames to hyperlinks (#trevor001)

Sub trevor001()
  Dim Cell  As Range
  For Each Cell In Selection
  ActiveSheet.Hyperlinks.Add Anchor:=Cells(Cell.Row, Cell.Column), _
            Address:="", SubAddress:="'" & Sheets(Cell.Value).Name & "'!A1"
  Next Cell
End Sub

Names of WorkSheets across columns from the activecell (#across)

List the worksheetnames across a row, starting in the activecell.
Sub SheetNamesAcrossColumns()
  Dim iSheet As Long
  For iSheet = 1 To ActiveWorkbook.WorkSheets.Count
    ActiveCell.offset(0, iSheet - 1) = WorkSheets(iSheet).Name
  Next iSheet
End Sub
To Reference cell $a$4 on the worksheet named in Row 1
   =INDIRECT( "'" & D1 & "'" & "!$a$4")
those are single quotes enclosed in double quotes to allow use of sheetnames with embedded spaces.  

GoToSub -- Display Subroutine named in selected cell (#GoToSub)

GoToSub will send you off to the VBE coding for subroutine or Function displayed in cell. 
Using GoToSub  described on my Toolbars page.  GoToSub was formerly named GoToSubroutine. 
Change made 2000-04-13 to also pick the function from a formula.   i.e.  =Property("Last Save Time")
'Display Subroutine or Function named in selected cell
Sub GoToSub()
   'David McRitchie 1999-11-12 rev. 2000-04-13
   'http://dmcritchie.mvps.org/excel/buildtoc.htm
   On Error GoTo notfound   'formerly named GoToSubroutine
   Dim i As Long
   Application.Goto Reference:=ActiveCell.Value
   Exit Sub
notfound:   
   On Error GoTo notfound2
   If Left(ActiveCell.Formula, 1) = "=" Then
      For i = 1 To Len(ActiveCell.Formula)
        If Mid(ActiveCell.Formula, i, 1) = "(" Then
          MsgBox Mid(ActiveCell.Formula, 2, i - 2)
          Application.Goto Reference:=Mid(ActiveCell.Formula, 2, i - 2)
          Exit Sub
        End If
      Next i
      MsgBox Mid(ActiveCell.Formula, 2, i - 2) _
        & "was not found as a User Defined Function, " _
        & "verify with Paste Function Wizard [fx]"
   End If
notfound2:  
   On Error Resume Next
   MsgBox "Procedure or Function " & ActiveCell.Value _
      & " is not available, try ALT+F8 to find Sub, or [fx] to find UDF"
End Sub
As an alternative to GoToSub you can use Alt+F11, then F2 (View, Object Browser), select All Libraries or a specific library such as personal.xls then under classes choose global and look form macro in boldface to the right.

Also of interest:  You can Hyperlink to VBA module (Andy Wiggins, misc, 2002-08-17),

In Excel 97:  Insert > Hyperlink: In “Named location in file (optional):” put the name of the procedure.
 So if the procedure name is MyProc, you would enter “MyProc”.
In Excel 2000:  Insert > Hyperlink: Click on “Existing File or Web Page”,
 then in “Type the file or Web-page name” put the name of a procedure preceded by a hash (#).
 So if the procedure name is MyProc, you would enter “#MyProc”.
In Excel 2002 (XP):  Insert > Hyperlink: Click on ”Existing File or Web Page”,
 then in “Address” put the name of a procedure preceded by a hash (#).
 So if the procedure name is MyProc, you would enter “#MyProc”.

RunSubFromActiveCell     (#RunSubFromActiveCell)

This one is kind of like have a command button or a menu item, but using a cell instead to identify the macro to be run.  Created this one to relate to the macros near here.  Most of my macros require a preselected area first so expect this to be of limited use.  Also see Alt+F8 and MacroDialogBox Macros [Alt+F8]  in my Toolbars page.
Sub RunSubFromActiveCell()
   Application.Run ActiveCell.Value
End Sub
Examples of content for Activecell:
mymacro
personal.xls!mymacro

GoToSheet -- Select the Sheet named in selected cell (#GoToSheet)

This subroutine will goto (select) the sheet named in the selected cell.  XL95 users should find this useful as a substitute for hyperlinks available in later versions.
Sub GoToSheet()
  'David McRitchie
  On Error Resume Next
  If Worksheets(ActiveCell.text) Is Nothing Then
    MsgBox ActiveCell.text & " -- sheet does not exist"
  Else
    Sheets(ActiveCell.text).Select
  End If
  On Error GoTo 0
End Sub

To select a sheet with a known name in VBA

     Application.Goto Reference:=Range("'Radio Stations'" & "!a1")
The sheetname is enclosed with single quotes to allow you to code a sheet with spaces in the name, that in turn is surrounded by double quotes.

For a variation of GoToSheet, see GoToCustomerSheet, which uses an input box to ask for a customer which equates to a sheetname.

A similar EVENT macro installed to a worksheet (RClick, View code).  Note use of Target.Text to pick up a sheet named '00085' for which target.value would not work.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  'David McRitchie http://dmcritchie.mvps.org/excel/buildtoc.htm#gotosheet
  On Error Resume Next
  Cancel = True   'Get out of edit mode 
  If Worksheets(Target.Value) Is Nothing Then
    MsgBox Target.Value & " -- sheet does not exist"
  Else
    Application.Goto Reference:=Worksheets(Target.Text).Range("A1"), _
      Scroll:=True
  End If
  On Error GoTo 0
End Sub

Summary of possible steps:   (Gary Brown)
   Workbooks.Open Filename:="C:\Temp\Myfile.xls"
   Windows("Myfile.xls").Visible = True
   Application.Goto Reference:="sheetaa!C14"

Repositioning screen and/or active cell (#TopLeft)

Suppose that the cell you have active is cell  D150 you might want to see some cells to the left.  Of course use of Window, Freeze pane would be useful also.
'Active cell repositioned to Top also showing 5 cells to left
'   remains on same sheet
Sub ShowTopLeft5()
        Dim caddr As String
    caddr = Selection.Address
    Application.Goto Reference:=Cells(ActiveCell.Row, _
        Application.WorksheetFunction _
        .Max(1, ActiveCell.Column - 5)), Scroll:=True
    Range(caddr).Select
End Sub

Place active cell in top left of viewable area (#showtopleft)

A simpler version just makes the activecell the top left cell.
'repositition active cell to Top Left corner
'   remains on same sheet
Sub ShowTopLeft()
    Application.Goto Reference:=Range(ActiveCell.Address), _
        Scroll:=True
End Sub
Also see last cell page for last cell in a range.

Subroutine and Function Table for Open Workbooks (#ListFunctionsAndSubs)

The following came about from efforts with Chip Pearson, Bernie Deitrick, and myself.  Column G and H are actually blue since they are not attributes of VBA code.

ListFunctionsAndSubs

 ABCDEFGH
1 Book Module Name Type Beg# Lns ### chk
2 testng2k.xls Module4 AltRowDelete SubRoutine 35 8 132  
3 personal.xls Module1 auto_Open SubRoutine 1 7 1 Dup
4 testng2k.xls Module1 auto_open SubRoutine 2 13 24 Dup
5 testng2k.xls Module19 Beep2 SubRoutine 7 34 155  
6 testng2k.xls Module13 GetCellFormat SubRoutine 18 11 142  
7 personal.xls Module1 GetFormat Function 31 6 5 Dup
8 testng2k.xls ModuleF GetFormat Function 24 6 71 Dup
9 personal.xls Module1 MarkSepAreas SubRoutine 72 14 12  
10 testng2k.xls Module1 Upper_Case SubRoutine 70 15 29  
11 personal.xls Module1 UseFormula Function 8 6 2 Dup
12 testng2k.xls ModuleF UseFormula Function 1 6 68 Dup
13testng2k.xlsModule1XL2HTMLSubRoutine 1745435 
14 testng2k.xlsmod.XL2HMLxXL2HTMLxSubRoutine 897166 

Separate coding for ListFunctionsAndSubs List Subs and Functions can be found here, references to similar material can be found in the Related area of this page, such as Chip Pearson’s  “Coding for the VBE”.

A companion piece of code that is used (#ShowSubOrFunction), since I could not establish hyperlinks to subroutines and functions within the VBA editor, and it is shown below and can be assigned to a single button.  You may select any cell on the row to get to the code.  Be forewarned that each time you invoke the subroutine another window page is stored so you might want to use the little [x] to get out of that code module each time (not talking about the big [X] to get out of the VBA editor.  ShowSubOrFunction is specialized to this table see GoToSub GoTo Sub or Function for a more generic macro (see Tool Bars to assign to a toolbar button).

Sub ShowSubOrFunction()
'--Companion to ListFunctionsAndSubs, for lack of a hypertext solution.
'--Application.Goto Reference:=WBName & "!" & Subname
Application.Goto Reference:=Cells(ActiveCell.Row, 1).Value _
         & "!" & Cells(ActiveCell.Row, 3).Value
End Sub
Something else of interest: Barhopper -- fixup for Restored Toolbars, and -- Listing of Menu Items

avoiding duplicate references (#dup_refs)

It is possible to have more than one subroutine with the same name and to separately address them, but you cannot have two subroutines (or UDFs) with the same name within the same moudule.  Check the topic title in VBA Help, Answer Wizard: avoiding naming conflicts
  YourProject.YourModule.YourSub
  MyProject.MyModule.MyVar
  project1.mysub
  project2.mysub
  module1.mysubroutine
  module2.mysubroutine

Another Function, Subroutine listing

Meanwhile Myrna Larson and Dave Braden are working on the following that is a bit more comprehensive -- but needs the Bookname added.  Newsgroup postings for this and the previous can be found in the excel.programming newsgroup on 1999-09-09 and the thread.

  Didn't have a chance to look at this posting 2002-03-08 by Myrna, I think it extracts codes from Add-Ins, if so, could be used to include add-in functions.

Note the ListFunctionsAndSubs mention above does include bookname.

 ABCDEFGH
1 WORKBOOK: LISTSUBS.XLS, 7 Sep 1999              
2 Module ModType Priv? Procedure Name Type Priv? Parms? Line #
3 ListSubsCode Std   ListProcedures Sub     44
4 ListSubsCode Std   GetProcedures Sub X X 161
5 ListSubsCode Std   ModuleIsPrivate Function X X 282
6 ListSubsCode Std   ReadTheLine Sub X X 298
7 ListSubsCode Std   GetProcedureInfo Sub X X 320
8 ListSubsCode Std   NextWord Function X X 420

References - VBAProject -- Tools, References (#addins)

List all your current references to a worksheet including the Description, Name, GUID, #MAjor, #Minor, full path.  [Gary Brown, see thread] apparently based on code by Frank Arendt-Theilen.
 ABCDEF
1DescriptionName GUID#Major #MinorPath
2Visual Basic For Applications VBA{000204EF-0000-0000-C000-000000000046} 40 C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6.DLL
3Microsoft Excel 9.0 Object Library Excel{00020813-0000-0000-C000-000000000046} 13 C:\Program Files\Microsoft Office\Office\EXCEL9.OLB
4OLE Automationstdole {00020430-0000-0000-C000-000000000046}2 0C:\WINDOWS\SYSTEM\stdole2.tlb
5Microsoft Office 9.0 Object Library Office{2DF8D04C-5BFA-101B-BDE5-00AA0044DE52} 21 C:\Program Files\Microsoft Office\Office\MSO9.DLL

List Sheet Names (#EnumerateSheets_XL95)

EnumerateSheets_XL95 is an Older and shorter version of BuildTOC in use before introduction of hyperlinks in XL97.  This simple version works in XL95 and up. (BuildTOC does also, but w/o hyperlinks when run in XL95).
Sub EnumerateSheets_XL95()
  'listed from active cell down 2-cols --  DMcRitchie 1999-03-04
  Application.Calculation = xlManual   'xl97 up use xlCalculationManual  
  Application.ScreenUpdating = False
  cRow = ActiveCell.Row
  cCol = ActiveCell.Column
  For csht = 1 To ActiveWorkbook.Sheets.Count  'worksheet or sheets
     Cells(cRow - 1 + csht, cCol) = "'" & Sheets(csht).Name
     Cells(cRow - 1 + csht, cCol + 1) = TypeName(Sheets(csht))
    '-- include next line if you want to see cell A1 for each sheet
     Cells(cRow - 1 + csht, cCol + 2) = Sheets(Sheets(csht).Name).Range("A1").Value
  Next csht
  Application.ScreenUpdating = True
  Application.Calculation = xlAutomatic   'xl97 up use xlCalculationAutomatic
End Sub
Similar to the above.  Exceptions: uses OFFSET.  Populates with the A1 cell from each worksheet.
The name of the worksheet being secondary is placed in the adjacent column.

List of A1 Cells by Sheetname (#GetAllA1Cells)

Sub GetAllA1Cells()
  Application.ScreenUpdating = False  'DMcRitchie 2000-10-24
  Application.Calculation = xlCalculationManual
  Dim iSheet As Long
  For iSheet = 1 To ActiveWorkbook.Worksheets.Count
    ActiveCell.Offset(iSheet - 1, 0) = Worksheets(iSheet).[a1].Value
    ActiveCell.Offset(iSheet - 1, 1) = "'" & Worksheets(iSheet).Name
  Next iSheet
  Application.Calculation = xlCalculationAutomatic
  Application.ScreenUpdating = True
End Sub

Other Cell Hyperlink usages (#hyp)

Hyperlink information formerly included above is now below see #hyperlink for HYPERLINK Worksheet Functions, see hyperlinkaddress for User Defined Funtions and Macros to display, remove hyperlinks.

Removing object hyperlinks from a Cell or cell range appears in a later topic see #DelHyperlinks.

Create a button on worksheet to invoke a macro (#Build_SS_Button)

Sub Build_SS_Button()
    'Build button on spreadsheet to invoke macro
    'adapted from a posting by "Jim/Nospam" on 30Aug1999
    ActiveCell.Select
    Selection.Copy
    ActiveSheet.Pictures.Add(251, 88, 75, 13).Select
    Selection.Interior.ColorIndex = 8
    Application.CutCopyMode = False
    Selection.OnAction = ActiveCell.Value   'Macro to be invoked
End Sub
To remove a button created as above, Right-Click/Cut

To create a button on toolbar see my page -- Toolbars and Custom Buttons

Using a hyperlink to run a macro

Don't think so, by you might be able to use a Click or Change_Event

Related Code Snippets   (#snippets)

'Show names of sheets in pop-up (same as Rclick on TabNav keys) -- Jim Rech
CommandBars("Workbook tabs").ShowPopup

'Rename current Sheet  -  Tom Oglivy
Application.Dialogs(xlDialogWorkbookName).Show
Code to check if an add-in is still active, if not, to reactivate it.  Also see EnumerateAddins to create a list of addins.
  If AddIns("Autosave Add-in").Installed = False Then
     AddIns("Autosave Add-in").Installed = True
     MsgBox "autosave add-in reset back to True"
  End If

Working with hyperlinks in Cells (#hyp2)

Manually entering a hyperlink in a Cell to a cell in another sheet (#CtrlK)

Avoid the creation of an automatic hyperlink (#avoid)

Avoiding taking the hyperlink when selecting a cell (#avoiding)

A similar problem is attempting to enter a formula into the formula bar and getting interference from cell addresses popping into the formula caused by backspacing or cell selecting when trying to key in the formula is to press the F2 beforehand.

Removing hyperlinks (#removing)

Function to show hyperlink URL used in another cell (#url)

Believe this is working now 2000-02-13 after minor tuneup, 2005-06-02 removed As String from first line (was okay in code folder).
Actually the extraction from the hyperlink is just an approximation.
Function URL(cell As Range)  '-- As String
  'Tom Ogilvy, programming 1999-04-14 Deja: AN=468281862
  'Chip Pearson, programming 1999-04-14 Deja: AN=468345917
  'David McRitchie, combined 1999-11-13
  'cannot process imbedded link to internal sheet yet ...
  If Trim(cell.Formula) = "" Then
     URL = ""
     Exit Function
  End If                            ' 1234567890122
  If Left(UCase(cell.Formula), 11) = "=HYPERLINK(" Then
    If Left(UCase(cell.Formula), 12) = "=HYPERLINK(""" Then
      URL = Mid(cell.Formula, 13, InStr(1, cell.Formula, ",") - 13)
      Exit Function  'next part for nonquoted first parm
    End If
    URL = Mid(cell.Formula, 12, InStr(1, cell.Formula, ",") - 12)
    Exit Function
  End If
  URL = ""
  On Error Resume Next
  URL = cell.Hyperlinks(1).Address
  If URL = 0 Then URL = "'**"
End Function

HyperlinkAddress   (#Hyperlinkaddress)

This simpler one works for object hyperlinks.  To attempt to include =HYPERLINK(...) use the URL function (above).  Looks like John Walkenbach had coding 1999-02-26 earlier than my 2000-04-03 on my webpage, but you do want to include the extra line of code to cover for cells without links as from your exported favorites listing.  A similar function but one that prefaces relative links with the workbook Hyperlink base (file, properties) can be found in Harlan Grove's reply in misc 2002-04-26 to make the absolute links (means including the Hyperlink Base) for http:, fttp;, mailto: 
See later topic for HYPERLINK Worksheet Function
Function HyperlinkAddress(cell) As String
   If cell.Hyperlinks.Count > 0 Then _
     HyperlinkAddress = cell.Hyperlinks(1).Address
End Function

usage:  To display the (object type) hyperlink used in another cell
   =HyperlinkAddress(A2)
   =personal.xls!hyperlinkaddress('links sheet'!A2)
If you paste bookmarklets.html or favorites into Excel you can extract the hyperlinks as above, and you can find how much padding is in the cell according to the IndentLevel which can be determined with the following function.
Private Function indented(cell) As Long
  'Leftside Padding level (count),   D.McRitchie 2007-07-26
  indented = cell.IndentLevel   'cell padding on left
End Function

Private Function LSpaces(text) As Long
  'Leading/Left Spaces count,  D.McRitchie 2007-07-26
  LSpaces = Len(Text) - Len(LTrim(Replace(Text, Chr(160), " ", , , vbTextCompare)))
End Function


Function HyperlinkScreenTip(cell)
    On Error Resume Next
    HyperlinkScreenTip = cell.Hyperlinks(1).ScreenTip
    If HyperlinkScreenTip = 0 Then HyperlinkScreenTip = ""
End Function
Although it would be redundant you could have a function to show TextToDisplay.
Function HasHyperlink As Boolean
    'Dave Peterson, programming 2001-12-20
    'Application.Volatile = True
    On Error Resume Next
    HasHyperlink = (Len(rng(1).Hyperlinks(1).Address) <> 0)
End Function 
Usage: Returns True or False, but I think one would normally incorporate the code within a macro and not as a function, or just obtain a hyperlink and program for the error if no hyperlink.

=IF(personal.xls!HasHyperlink(sheet4!A14,"Sheet4!A14 has a hyperlink","")
or in VBA:  MsgBox HasHyperlink(ActiveCell)

Bill Manville’s solution (#HyperLinkText), 2002-07-26, covers Excel links as well as webpage (& email) URL's.  Anything in an object type hyperlink (Ctrl+K, Edit hyperlink).

Function HyperLinkText(oRange As Range) As String
  Dim ST1 As String, ST2 As String
  If oRange.Hyperlinks.Count = 0 Then Exit Function
  ST1 = oRange.Hyperlinks(1).Address
  ST2 = oRange.Hyperlinks(1).SubAddress
  If ST2 <> "" Then ST1 = "[" & ST1 & "]" & ST2
  HyperLinkText = ST1
End Function
Using a Function to find the hyperlink in a shape would take a lot of processing for a function to cycle through all shapes, so a Subroutine that places the link into the cell to right would be more practical and the subroutine ExtractLinkToRightOfShapes can be found on shapes page.

 ABCDE
9  =getformula(A10) =HyperLinkText(A10) =url(A10) =hyperlinkaddress(A10)
10 abc abchttp://abc.go.com/http://abc.go.com/ http://abc.go.com/
11A8   =Orig.NEW!A8[]Sheet2!B3  
12B3 =HYPERLINK("[project_text.xls]Sheet2!B3","B3")  [project_text.xls]Sheet2!B3" 
13No LinkNo Link    

If you change the object hyperlink without reentering it the Function will not show the updated value when changed or when recalculated [F9] until a complete recalculation is performed [Ctrl+Alt+F9]

<a href="http://www.nbc.com/" title="NBC Channel 4 in New York city">NBC</a>

  ActiveSheet.Hyperlinks.Add Anchor:=Range("C22"), Address:= _
     "http://www.nbc.com/", ScreenTip:="NBC Channel 4 in New York city", _
     TextToDisplay:="NBC"
To display the HyperlinkScreenTip (function described earlier

Link to a Chart or Shape, faked by an Event Macro,
Hyperlinks in Excel, Jon Peltier, some notes on hyperlinks including how to fake a link to a chart (or other shapes).

Bookmarklets (#bookmarklets)

If you want to see the hyperlinks within a web page, you can use a Bookmarklet to display the link url after the link see bookmarklets and look for “HREF visible” and click on it.  Another bookmarklets solution is to create another page that shows the links (to remove changes, hit F5 to refresh), see bookmarklets.com tools look for “list of all links” and click on it.
(Removing hyperlinks, deleting hyperlinks, delete hyperlinks, create hyperlinks)
You can usually hit Ctrl+Z  to back out a hyperlink you typed if done immediately after it shows up.  It will not work for something you entered by pasting.  You can manually remove such hyperlinks as follows: Please note the following behavior:  Hyperlinks created with other cells via the fill-handle at same time as those in selection area may also have their hyperlinks removed.  Another negative aspect is that all formatting is lost including Font color, interior color, horizontal alignment (at least in XL2000).  Possible solution, save & redo each cell format.

The following macro will delete hyperlinks from the selected area.  It will not delete those you create with =HYPERLINK(..) formula.

    Sub DelHyperlinks()
       Selection.Hyperlinks.Delete
    End Sub
note: The above macro appears to have some problems with multiple selections (those done using Ctrl), and may delete an additional hyperlink(s) if the hyperlinks were created using the fill-handle.

A non macro solution:  Select an empty cell (never used cell) and copy it (Ctrl+C) then select the cells or column that you want to remove the hyperlinks from, then  Edit, Paste Special, Add

I normally use it on individual columns and don't have problems with the DelHyperlinks macro in that regard.

    Sub DelAllHyperlinks()
       ActiveSheet.HyperLinks.Delete
    End Sub

To delete only the screen tips, so that you will only see the url when you pass cursor over the cells. (#RemoveScreenTips)

   Sub RemoveScreenTips()
     'David McRitchie, misc, 2003-04-08, misc
     Dim cell As Range
      For Each cell In Intersect(Selection, ActiveSheet.UsedRange)
       On Error Resume Next
       cell.Hyperlinks(1).ScreenTip = ""
     Next cell
   End Sub
See the related area for the complicated means of automatically removing hyperlinks.  For those with Excel XL (Excel 2002) you can suppress hyperlink generation under the Auto Correct from the Tools menu.
    Tools (menu), Autocorrect Options, Autoformat as you type (Tab).

To select all hyperlinks (not formula hyperlinks) in a selection

   Sub SelectHyperlinks()
    'D.McRitchie 2001-01-24  buildtoc.htm
    Dim hl As Variant
    Dim rng1 As String
    For Each hl In ActiveSheet.Hyperlinks
        rng1 = rng1 & "," & hl.Parent.Address(0, 0)
    Next hl
    If rng1 = "" Then
      MsgBox "No Hyperlinks found in Sheet, so none in selection"
      Exit Sub
    End If
    rng1 = Right(rng1, Len(rng1) - 1)
    On Error Resume Next
    Intersect(Selection, Range(rng1)).Select
    If Err.Description = "" Then Exit Sub
    MsgBox "Change your initial selection" & Chr(10) & _
      "there are hyperlinks, but none in you initial selection" _
      & Chr(10) & Err.number & " " & Err.Description
   End Sub

If you want do delete links, especially !REF# errors, see Find Links (findlink) by Bill Manville in the MVP area of Steve Bullen’s site.  To prevent creation of selected hyperlinks see KB 233073 see Using an Event Handler to disable automatic hyperlinks (McGimpsey) it is an Event macro that will be invoked each time a link is changed. 

Alternative to preventing generation of a hyperlink (#preventhyp)

You can immediately undo the hyperlink with UNDO (Ctrl+z).  If you have not entered a hyperlink already you can precede the text with a single quote.

XL2002: How to Prevent the Automatic Creation of Hyperlinks, Disable the AutoFormatting Option.  (prior to XL2002 use an event macro as in KB 233073 see instead Using an Event Handler to disable automatic hyperlinks (McGimpsey))

      Macro should be changed to allow   =HYPERLINK("#"&CELL("address",C5),C5)  as described in sheets.htm page.

Sub ConvertHyperlinks()
    'David McRitchie, misc, 2000-01-17, misc
    'http://dmcritchie.mvps.org/excel/buildtoc.htm
    Dim cell As Range
    Dim hyperlinkaddress As String, hyperlinkformula As String
    For Each cell In Selection
      On Error GoTo skipHyper
      hyperlinkaddress = cell.Hyperlinks(1).Address
      On Error GoTo 0
      If hyperlinkaddress = "" Then GoTo skipHyper
      hyperlinkformula = cell.Formula
      If Left(hyperlinkformula, 1) = "=" Then
        hyperlinkformula = Right(hyperlinkformula, Len(hyperlinkformula) - 1)
      Else
        hyperlinkformula = Replace(hyperlinkformula, """", """""")
        hyperlinkformula = """" & hyperlinkformula & """"
      End If
      cell.Formula = "=HYPERLINK(""" & hyperlinkaddress & _
        """," & hyperlinkformula & ")"
skipHyper:  On Error GoTo 0
    Next cell
    On Error GoTo 0
    Selection.Hyperlinks.Delete
    For Each cell In Selection
      cell.Formula = cell.Formula
    Next cell
End Sub
See note on compatibility Replace not available in Excel 97.

GoToHTML macro     (#GoToHTML)

If you do remove the hyperlinks you could use this method to get to the displayed link.  Also see GoToHyperlink
Sub GoToHTML()
    'David McRitchie, 2000-12-13
    'documented in http://dmcritchie.mvps.org/excel/buildtoc.htm
                'selected cell contains    http://www.abcexample.com
    On Error Resume Next
    If Len(Trim(ActiveCell.Value)) = 0 Then Exit Sub
    ActiveWorkbook.FollowHyperlink Address:=ActiveCell.Value, _
      NewWindow:=False, AddHistory:=True
    If Err.number <> 0 Then
      MsgBox Err.number & " " & Err.Description & Chr(10) & _
      "Tried to bring up file in " & ActiveCell.Address(0, 0) & _
      Chr(10) & ActiveCell.Text
    End If
   'Application.WindowState = xlNormal -- what would this do?
End Sub
The following will take the hyperlink, if it fails you can paste the failed hyperlink into a Find dialog where used.  In the VBE use Tools menu, References, place a check next to “Microsoft Forms 2.0 Object Library”.  [ref.]
   Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     Dim MyDataObj As New DataObject
     Dim pLnk As String
     Cancel = True   'Get out of edit mode 
     pLnk = Trim(ActiveCell.Value)
     On Error GoTo Failure
     MyDataObj.SetText pLnk
     On Error Resume Next
     MyDataObj.PutInClipboard
   Failure:
    
    
     GoToHTML  '-- or GoToHyperlink  (also seen on this page)
     ActiveCell.Interior.ColorIndex = 20
   End Sub

Fix colors for hyperlinks (#HyperlinkStyle)

Sometimes formatting of link colors is hidden.  To restore the normal hyperlink style for hyperlinks, Bill Manville, Links, 2002-12-16
Sub RestoreHyperlinks_UsingStyle()
 Dim H As Hyperlink
 For Each H In ActiveSheet.Hyperlinks
   H.Range.Style = "Hyperlink"
 Next
End Sub
Or You could change the hyperlink style manually:  format, style,Hyperlink (in the dropdown) modify change the font size, font color, etc.
Make the hyperlink replace the text and remove the actual hyperlink. (not my type of choice)
The following appears to work only via trial and error.
Sub MakeTextOnlyFromHyperlinks()
  'David McRitchie, 2000-08-23 worksheet.functions !!
  Dim cell As Range
  Dim URL As String
  For Each cell In Selection
    If IsEmpty(cell) Then GoTo chknext
    MsgBox cell.Address
    URL = ""
    On Error Resume Next
    URL = cell.Hyperlinks(1).Address
    If Err.Number = 9 Then GoTo chknext
    If Trim(URL) = "" Then GoTo chknext
    cell.Value = URL
    cell.Hyperlinks(1).Delete
chknext:    On Error GoTo 0
  Next cell
End Sub
 ABC
1Site  =GetFormula(Bn)
2ABC X =IF(A2="","",HYPERLINK("http://www." & A2 & ".com","X"))
3Microsoft X =IF(A3="","",HYPERLINK("http://www." & A3 & ".com","X"))
4NBC X =IF(A4="","",HYPERLINK("http://www." & A4 & ".com","X"))
5NBCi X =IF(A5="","",HYPERLINK("http://www." & A5 & ".com","X"))

Besides the obvious advantage of creating Hyperlinks on the fly, is that you can easily change column A without having to use keyboard tricks to avoid taking the link when changing the sites.

The URL formula described on this page will not work on the HYPERLINK formulas shown above.

Worksheet code that created a hyperlink

=HYPERLINK("h:\excel2k\testng2k.xls#sheet3!a1","SHEET3")
=HYPERLINK("[h:\excel2k\testng2k.xls]sheet3!a1","SHEET3")
=HYPERLINK("[d:test\test.xls]test!b5","thisone good b5")
=HYPERLINK("d:\website\dmcritchie","dmcr")
=HYPERLINK("d:test\test.xls","thisone is also good")
=HYPERLINK("[testng2k.xls]'$$TOC'!A56","heidi-ho $$TOC!A56")
=HYPERLINK("[h:\excel2k\testng2k.xls]'$$TOC'!a3","text in a3 in $$TOC")
=HYPERLINK("[file:\\\d:test\test.xls]test!B3","thisone is good")
=HYPERLINK("[http://www.business.com/report/budget report.xls]Annual!F10","Report")
=HYPERLINK("[vlookup.xls]'sheet"&F2&"'!a4","sheet"&F2)   -- using a cell
=HYPERLINK("[vlookup.xls]'sheet"&ROW()+38&"'!a4","sheet"&ROW()+38)  -- cell and sequence

=HYPERLINK("[<a href="http://dmcritchie.mvps.org/excel/excel.htm">http://dmcritchie.mvps.org/excel/excel.htm</a>]","My Excel Pages")
=HYPERLINK("file:\\\c:\temp\David McRitchie\a.txt","thisone is good")
It appears that even if the link is to a cell in the same worksheet you must include the bookname including .XLS extension, as well as the sheetname.

  =HYPERLINK("[WBName.xls]Michael!A5", "Michael I")

Additional updated information on the HYPERLINK Worksheet Function can be found on the sheets.htm#hyperlink page.  Specifically formulas that do not need the pathname within the same workbook.
  =HYPERLINK("#"&CELL("address",'sheet two'!C5),'sheet two'!C5)

Using HYPERLINK Worksheet Function, where workbook name can change

As aready mentioned you must include the filename, even if it refers to a cell in the same workbook.  You can use this code to generate the workbook name.  As mentioned on my Pathname page you must include the cell reference to get a valid result from the CELL Worksheet Function. 

B3:  =MID(CELL("filename",A1),FIND("[",CELL("filename",A1),1)+1,FIND("]",CELL("filename",A1),1)-FIND("[",CELL("filename",A1),1)-1)

and use it as follows:
A1:  =HYPERLINK("["&hyperlink!$B$3 & "]'Sheet One'!A1","Sheet One")

Obtain a hyperlink address and friendly name from linked cell

programming version

See URL function above.  Examine formula instead for those entered as HYPERLINK(...)
        URL = ActiveCell.Hyperlinks(1).Address    'see note on HYPERLINK
        URL_Display = ActiveCell.value

Using the URL function on the Worksheet

Using the User Defined Function to obtain the link address:
  =URL(D4)
  =personal.xls!URL(D4)
Using a Worksheet Function to obtain the text value
  =D4

When using a function that exists in a different workbook, include the workbook name as shown above, failure to find your function will result in an error -- #NAME?

some notes on mail links

The blue underlined font characteristic of a link can be overridden by changing the font, and/or underlining.  It can be removed also by using the "format painter" (paintbrush) from the menu.  This does not change the underlying link.

In XL2000 if you type an email address (or something that looks like one) you can hit UNDO (ctrl+z) and the link portion will disappear along with the font formatting of a link.

When the link has been established typing into the cell will not affect the link, unless what you type is another hyperlink, which will create the link (in this case replace) in the normal fashion.  More information on mailto in my Mail Merge page.

I also noticed that while recording a macro that typing in an email address  

DMcRitchie@example.com
  will NOT create a hyperlink, but once I stop recording, the email address link will be created.  (maybe someone has an explanation for this -- XL2000).

Specific Hyperlink usages

Email
    =Hyperlink("mailto:DMcRitchie@example.com","David McRitchie")

TCP/IP Transmission Control Protocol/Internet Protocol (Internet)
    =Hyperlink("telnet://" & A1,A1)

Creating Hyperlink for a single selected cell

To create a single hyperlink from the value in the cell.
i.e.
h:\myfiles\myfolder\excelabc.xls#sheet3!H14
  
   Sub single_hyp()
      ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell, Address:=ActiveCell.Value
   End Sub
 
  Sub MakeHyperlinks()
  Dim cell As Range
  For Each cell In Intersect(Selection, _
            Selection.SpecialCells(xlConstants, xlTextValues))
     With Worksheets(1)
       .Hyperlinks.Add Anchor:=cell, _
        Address:=cell.Value, _
        ScreenTip:=cell.Value, _
        TextToDisplay:=cell.Value
      End With
  Next cell
End Sub
For a better solution see MakeHyperLinkFormulas", which creates hyperlinks with the HYPERLINK formulas.
Sub MakeHyperlinks_D()
  Dim cell As Range, Rng As Range
  Set Rng = Range("D2:D" & Cells.Rows.Count). _
        SpecialCells(xlConstants, xlTextValues)
  If Rng Is Nothing Then
     MsgBox "nothing in range"
     Exit Sub
  End If
  For Each cell In Rng
    If Trim(cell.Value) <> "" Then
       ActiveSheet.Hyperlinks.Add Anchor:=cell, _
        Address:=cell.Value, _
        ScreenTip:=cell.Value, _
        TextToDisplay:=cell.Value
    End If
  Next cell
End Sub
Based on MakeHyperlinks above but created separately.  "mailto:" will be prefixed in creating the hyperlink.
Sub MakeEmailLinks()
   Dim cell As Range
   Dim i As Long
   For Each cell In Intersect(Selection, _
            Selection.SpecialCells(xlConstants, xlTextValues))
     If InStr(1, cell, "@") > 0 Then
         With Worksheets(1)
           .Hyperlinks.Add Anchor:=cell, _
            Address:="mailto:" & cell.Value, _
            ScreenTip:=cell.Value, _
            TextToDisplay:=cell.Value
         End With
     End If
   Next cell
End Sub
For a better solution see MakeHyperLinkFormulas", which creates hyperlinks with the HYPERLINK formulas.
Sub Fix192Hyperlinks()
    Dim OldStr As String, NewStr As String
    OldStr = "http://192.168.15.5/"
    NewStr = "http://hank.home.on.ca/"
    Dim hyp As Hyperlink
    For Each hyp In ActiveSheet.Hyperlinks
         hyp.Address = Replace(hyp.Address, OldStr, NewStr)
    Next hyp
End Sub
If you want to fix the display text you can also include .TextToDisplay

There have been postings to fix hyperlink paths in the excel.links newsgroup.  Also see if Dick Kusleika’s code and explanation helps, it is found in http://google.com/groups?threadm=u7jGaPnWCHA.1748%40tkmsftngp09

MakeHyperlinkFormulas from URL address or Email addresses     (#MakeHyperlinkFormulas)

Object type hyperlinks can lead to performance problems.  The following will create HYPERLINK formulas less prone to problems and will combine the functionality of both of the previous macros.  The @-sign will be used to determine email addresses, which is not always a perfect choice, so it comes down to knowing both your data and your macro usage.
 Sub MakeHyperlinkFormulas()
   Dim cell As Range
   Dim hyperlinkaddress As String, hyperlinktext As String
   For Each cell In Selection
       hyperlinkaddress = Trim(cell.Text)
       hyperlinktext = Trim(cell.Text)
       If hyperlinktext = "" Then GoTo skipit
       If hyperlinktext <> "" Then
         If InStr(1, hyperlinkaddress, "@") Then
           If LCase(Left(hyperlinkaddress, 7)) <> "mailto:" Then
              hyperlinkaddress = "mailto:" & hyperlinkaddress
           End If
         Else
          if Instr(1,hyperlinkaddress,".") = 0 then goto skipit
          If LCase(Left(hyperlinkaddress, 7)) <> "http://" Then
            hyperlinkaddress = "http://" & hyperlinkaddress
          End If
      End If
      cell.Formula = "=HYPERLINK(""" & hyperlinkaddress & _
         """,""" & hyperlinktext & """)"
 skipit:
   Next cell
 End Sub
To opposite of this is to delete all hyperlinks in selection, see DelHyperlinks above.

Additional items

Other Things you might want to keep on or near your $$TOC page

If you creating a masterlist for your Excel workbook you might want to also include:
  1. A list of other Excel files on your system.
  2. The last sheet that was modified during sessions use the crippled form =cell("filename"), which indicates the last sheet update; rather than the usually more correct =cell("filename",A1) which gives the information for the sheet where the formula resides.is used.  See HELP, Cell worksheet function; for more information.  The crippled form may be involved with some of my pages that showed through transparently to more recent sheets updated -- see ghosting problems.  Other people have same problem but apparently haven't been able to link any cause.  The ghosting problem can't be caused on demand so it will probably be with us for awhile.

Screen Tip (#screentip)

Am now using GoToHyperlink instead of myHyperlink

Screen Tips for hyperlink

Normally the screen tip will be the hyperlink, to override:
Right-Click on cell --> Edit hyperlink --> [Screen Tip]
   change the screen tip using the [Screen Tip] button,  hit OK (not the [X]
on the way out) both to the screen tip dialog and the hyperlink dialog on
the way out.

The generated code looks something like:
        Selection.Hyperlinks(1).ScreenTip = "ccccc"

With or without a Cross-Reference   (#AltF8)

Coding for Subroutines (SUB) can be located using ALT+F8, selecting the macro and using the EDIT button.

Subroutines marked Option Private Module can be invoked but will not show up in the menu ALT+F8, though they can be typed in and executed using RUN on the menu, or placed wherever a macro can be assigned. Subroutines with parameters list work very much like functions and don't show up in the Alt+F8 macro list either.

Coding for personal functions (Function) can be located from the VBA editor (Alt+F11) using F2 to get to the Object Browser.  Make sure the first entry "Globals" is selected then look for you functions in boldface next the green boxes interspersed with names and VBA constants.  (Functions do not show up in the Alt+F8 macros list)

The [fx] button (Paste Function Wizard dialog box) shows groups of functions including a list ALL functions (near top), the disliked most recently used (at the top), and the User defined functions (near the bottom) of the dialog box on the left-side.  The functions in the selected grouping appear in the right-side window.

Using the [=] button to left of the formula bar shows the most recently used functions.  If you look at bottom it says "Other functions" select that and you get the Paste Function dialog box that you get with the [fx] button.

Also see Chip Pearson's page on the differences between Macros and Functions.

Two reasons to convert your cell object hyperlinks to the HYPERLINK Worksheet Function are that the objects including hyperlink objects can cause serious problems when you have a lot of objects in a workbook.  The other advantage to converting is that you can use global replacements or modify them easier.
Sub forcelinks()
  Dim xlink As String
  Dim cell As Range
  For Each cell In Selection
    xlink = cell.Value
    If Left(xlink, 1) = "\" Then xlink = "C:" & cell.Value
    cell.Formula = "=HYPERLINK(""" & xlink _
       & """,""" & xlink & """)"
    Next cell
End Sub

preference of using:
    cell.Formula = "=HYPERLINK(""" & xlink _
       & """,""" & xlink & """)"
instead of:
    ActiveSheet.Hyperlinks.Add Anchor:=cell, Address:=xlink, _
            TextToDisplay:=xlink
a better alternative would be to enter a formula for HYPERLINK:
  cell.Formula = "=HYPERLINK(""" & xlink & """,""" & xlink & """)"
Sub GoToHyperlink()
  Application.Goto Reference:=Range(activecell.value), Scroll:=True
End Sub An alternative to actually creating a Hyperlink.  Note XL95 does not support hyperlinks in any manner.
    Application.Goto Range("A1000"), True  'Equivalent usage to those below

    'selected cell  contains   Sheet1!Z100
    '  goto indicated sheet and cell, scroll to display cell in top left corner
    Sub GoToHyperlink()
         Application.Goto Reference:=Range(activecell.value), Scroll:=True
    End Sub
Sub GoToHyperlink()
  Application.Goto Reference:=Range(activecell.value), Scroll:=True
End Sub
    'reposition to address in activecell on sheet named to left of cell
    ' i.e. cell to left of selected cell  contains   Sheet1, selected cell contains Z100
    Sub myHyperlink2()
        Application.Goto Reference:=Range(ActiveCell(1, 0).Value _
          & "!" & ActiveCell.Value), Scroll:=True
    End Sub

Examples:  Linking to a Web Page

   =HYPERLINK("http://dmcritchie.mvps.org/excel/excel.htm","My Excel Pages")

    My Excel Pages       in a cell then  RClick --> hyperlink
    http://dmcritchie.mvps.org/excel/excel.htm

    Sub Macro3()
       Range("D26").Select
       ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
            "http://dmcritchie.mvps.org/excel/excel.htm", _
            TextToDisplay:="My Excel Pages"
    End

Opening a Word Document from Excel (#xlOpensWord)

The following two macros were posted together by Harald Staff, misc, 2001-03-21
Sub GotoWebsite()
  Dim Link As String
  Link = "http://www.j-walk.com/ss/excel/tips/tip71.htm"
  'address is the origin og this code!
  On Error GoTo NoCanDo
  ActiveWorkbook.FollowHyperlink Address:=Link, NewWindow:=True
Exit Sub
NoCanDo:
  MsgBox "Cannot open " & Link
End Sub

before this you have to set reference to Microsoft Word object library in
"Tools > References" in the VB editor:

Sub OpenWordDocument()
  Dim wrdApp As Word.Application
  Set wrdApp = CreateObject("Word.Application")
  wrdApp.Visible = True
  wrdApp.Documents.Open ("C:\Temp\Textfile.txt")
  Set wrdApp = Nothing
End Sub
  There are many things you can do to navigate within a sheet.
  1. Shortcut keys such as lastcell (Ctrl+End), first cell in a row (Home), first cell in sheet (Ctrl+Home).  see keyboard shortcut keys (shortx2k.htm)
  2. Name box on left of formula bar allows you to type in a cell or a range to select cell or a range.
  3. Shortcut buttons that take you to top of a column, last used cell in a column, last used cell in row.  See Toolbars.htm page. Top of Column  Bottom of Column 
  4. To scroll fast press Shift key then grab the scroll bar.  Scroll bar will become small and the navigation will be very quick.
  5. The wheel on a wheel mouse allows you to move quickly within a few pages.
  6. The wheel button itself provides a different kind of navigation that is extremely fast.  The further you move the mouse away from the scroll point the faster you move.
  7. Another way that might simplify selection of a range is to the F8 key toggle which retains the first cell selected as one corner of the range and allows you to reselect the opposite corner until you hit F8 again.

    End of topic: Navigating within a Sheet, begin new navigation topic.

    ActiveSheet.Previous.Select
    ActiveSheet.Next.Select
    Sheets("Sheet1").Select
Subroutines navigating to the Next and Previous sheets can be seen as
   Previous Sheet  "GotoPrevSheet (Ctrl + PageUP" and
   Next Sheet  “GotoNextSheet (Ctrl + PageDN)" -- (don't forget to add the tooltips to your buttons)
in the code for GoToStuff loosely associated with this (BuildToc) web page.  Sometimes you cannot tell what sheet you are on such as after inserting a sheet, these navigation buttons allow you to hit one button then the other to make the current sheettab visible.  Err number 91 is provided for in each when there are no more sheet tabs in the direction asked for.  Related:  see Code for GoToNextSheet and GoToPrevSheet, Toolbar buttons, Installing a macro.

One advantage to a web page is that corrections and updates can be made, even though I had checked shortcut keys (XL 95) (XL 2000) and thought there were none for this, I found them later.  I like my short cut buttons to navigate backward or forward through the worksheet tabs but there are two shortcut keys that do the same thing.

   
   
    CTRL+PAGE DOWN  Move to the next sheet in the workbook
   
   
    CTRL+PAGE UP    Move to the previous sheet in the workbook

A reply post from Myrna Larson to provide for going back to the last viewed sheet <404ftsg4gk02rbi0l2t9hcqj4h5c6sh1f5@4ax.com>

Unsorted Selectable list of Sheetnames

Unsorted selectable list of sheets, RClick on any of the direction arrows to left of sheet TABs, this will pop up an unsorted list of sheets, for a scrollable list goto bottom.  This tip is repeated under Related - Alternatives at end of this web page.

The equivalent in VBA (Jim Rech):  CommandBars("Workbook tabs").ShowPopup
An enhancement by Chip Pearson to bring up withe More Sheets option already invoked, which works perfect for me but Shah Shailesh posted some additional comments about using msoControlbutton.

GoToSheet -- Go to a Specific Sheet (see #GoToSheet)

Covered in a previous topic GoToSheet

Specify Sheet as in Customer Name to go to


Sub GoToCustomerSheet()
     'David McRitchie  2000-07-15   excel.programming
     Dim WantedSheet As String
     WantedSheet = InputBox("Please Supply Customer Name" _
        & Chr(10) & "This should match a sheetname", _
        "Specify Customer")
     If WantedSheet = "" Then Exit Sub
     On Error Resume Next
     'to goto a cell you still need to slect the sheet first
     Sheets(WantedSheet).Select
     Sheets(WantedSheet).Range("B14").Select  'Optional
     If Err = 9 Then  'actually is subscript out of range
        MsgBox "Your worksheet was not found use RClick on " _
          & "Sheet Tab Navigation arrow in lower left corner " _
          & "to find desired sheetname."
     End If
End Sub

Running a macro for all worksheets in a workbook (#allworksheets)

To process names of all sheets with another macro.  For this example MarkCells was used on a new workbook to not damage anything.

If you were interested in the currently grouped sheets you could modify code to use

For Each sht In _
       Application.ActiveWorkbook.Windows(1).SelectedSheets
instead of
 For csht = 1 To ActiveWorkbook.Sheets.Count  'worksheet or sheets
       Cells(cRow - 1 + csht, cCol) = "'" & Sheets(csht).Name
The use of the array below would prevent sheet insertion/deletion or reselection of sheets during the running of the macro from causing problems.
Option Explicit
Sub AllWorkSheets()
    Dim Arr() As String
    Dim I As Long

    ReDim Arr(Worksheets.Count)
    Arr(0) = Worksheets.Count
    For I = 1 To Worksheets.Count
        Arr(I) = Worksheets(I).Name
    Next I

    For I = 1 To Arr(0)
      Sheets(Arr(I)).Select
      Application.Run "personal.xls!MarkCells"
    Next I
End Sub
Change section of code above to process only Selected sheets
    Dim sh As Worksheet
    I = ActiveWorkbook.Windows(1).SelectedSheets.Count
    ReDim Arr(0 To I)
    Arr(0) = I
    I = 1
    For Each sh In ActiveWorkbook.Windows(1).SelectedSheets
      Arr(I) = sh.Name
      I = I + 1
    Next sh

more on sheetnames in an array see http://www.cpearson.com/excel/excelM.htm

Hyperlinks come in two varieties in XL97 and up, and are not available in either variety before XL97.

Embedded hyperlinks that you create by Right-clicking on a cell and inserting a hyperlink create an object.

HYPERLINK Worksheet Formula is the other.  You can see both in my build.htm page, but mainly of the hyperlink object variety and programmed.

Since Chip Pearson has indicated that embedded hyperlinks can cause problems they add to the number of objects in your workbook, and that the formula hyperlinks do not cause problems, would suggest sticking to the Worsheet Functions variety, which you can include as a formula in programming, and double any internal quotes.
    see F1 (HELP) --> Index --> HYPERLINK Worksheet Function

(see examples on my Worksheet, VBA and Worksheet coding (sheets.htm) page.

Bookmarks, Favorites, My Places, Most Recently Used files (#bookmark)

Bookmarks or Favorites into a Spreadsheet

Incidentally you can paste your Internet Explorer Favorites (bookmarks) into an Excel spreadsheet.  File, Export, Favorites. create the (HTML) file, select the HTML which is really the Netscape bookmark format (select ALL), and paste into a worksheet.  But you can read all about that on my pages.  including how to extract the URL from the hyperlinks.  If you have the old Netscape 3.2 you sort the bookmarks and reinstall them as Favorites rather than the absurd limitations that you have in IE and in Netscape also now in order to be compatible, I guess.  If you begin your favorites foldernames with a space and not your webpages, this will work out nicely (sorting with Netscape 3.2).  Update on Bookmarks:  Netscape 6.0 will sort bookmarks temporarily.  Windows 2000 provides sorted bookmarks under favorites whereever seen, including with IE 6.0, also only temporary as an Export will not be an alphabetical order (folders first, then files).  IE 6.0 does not provide sorted bookmarks itself (i.e. not in Win98).
Sorting Bookmarks / Sorting Favorites -- (see topic in Arrangement of my Favorites Folder -- sort)

Most Recently Used Files   (#recentuse)

Excel 2000 provides up to 9

My Places

Q282087 -- OFFXP: How to Customize the My Places Bar in “Open” and “Save As” Dialog Boxes

Remove CRLF characters from ClipBoard (#RemoveCRLF)

Came up in a discussion in misc group concerning using the notepad to remove CRLF characters when addresses get splitup between lines in newsgroup postings.  This can also be done in VBA, though I doubt that you would actually experience this as much of problem within Excel.  LinkFix simply removes CRLF; whereas, LinkFix_GoTo will remove CRLF and take you to the link.  I have included separate replacement for CR and LF since UNIX machines don't produce CRLF to split lines. In the VBE use Tools menu, References, place a check next to “Microsoft Forms 2.0 Object Library”.
  Sub LinkFix()
    ' Dana DeLouis 2001-03-19 misc, using an
    ' Idea From: Chip Pearson
    '  http://www.cpearson.com/excel/Clipboard.aspx
    '= = = = = = = = =
    ' VBA Lib.Ref.: Microsoft Forms 2.0 object lib.
    ' Excel 2000 due to Replace() Function.
    '= = = = = = = = =
      Dim MyDataObj As New DataObject
      MyDataObj.GetFromClipboard
      Dim nLnk As String
      sLnk = Replace(MyDataObj.GetText, _
         vbCr, vbNullString)
      sLnk = Replace(sLnk, vbLf, vbNullString)
      sLnk = Replace(sLnk, vbLf, vbNullString)
      sLnk = Replace(sLnk, ">", vbNullString)
      sLnk = Replace(sLnk, " ", vbNullString)
      sLnk = Replace(sLnk, Chr(160), vbNullString) 
      MyDataObj.SetText sLnk
      MyDataObj.PutInClipboard
      Set MyDataObj = Nothing
  End Sub
 
  Sub LinkFix_GoTo()
    ' Dana DeLouis 2001-03-19 misc,
    '  Dave Peterson, added FollowHyperlink
    ' Idea From: Chip Pearson
    '   www.cpearson.com/excel/Clipboard.aspx
    '= = = = = = = = =
    ' VBA Library Reference:
    '    Microsoft Forms 2.0 object lib.
    ' Excel 2000 due to Replace() Function.
    '= = = = = = = = =
      Dim MyDataObj As New DataObject
      Dim lnk As String
      On Error Resume Next
      MyDataObj.GetFromClipboard
      lnk = Replace(MyDataObj.GetText, _
         vbCrLf, vbNullString)
      Set MyDataObj = Nothing
      ActiveWorkbook.FollowHyperlink _
        Address:=lnk, NewWindow:=True
    End Sub
See note on compatibility Replace not available in Excel 97.

MakeHTML_Link  personal.xls!MakeHTML_Link,   Message-ID replacements (“#”, “%23”), (“$”, “%24”), (“%”, “%25”).  More information on message-id.

The coding for Sub MakeHTML_Link() runs about 3 pages, so is not shown here, but can be found with the rest of the coding for BuildTOC.

The following will generate useful links via the MakeHTML_Link macro:

q142117 -- an MS KB article generates Q142117 --

abc.go.com generates abc.go.com (formerly http://www.abc.com)

qq142117 - will not generate a useful link

news:OYXnCHEbAHA.996@tkmsftngp03 generates a link for Google Usenet archives
news:OYXnCHEbAHA.996@tkmsftngp03
[ http://groups.google.com/groups?oi=djq&as_umsgid=OYXnCHEbAHA.996@tkmsftngp03 ]

angel@example.com generates
mailto:angel@example.com

http://support.microsoft.com/default.aspx?scid=kb;en-us;Q142117 generates
http://support.microsoft.com/default.aspx?scid=kb;en-us;Q142117

of possible interest: TransURL - URL Translation Utility [archive]

Special Note on Compatibility   (#replace)

Replace was not available in Excel 97 so for XL97 you would have to use Excel Substitute instead of VBA Replace.  i.e.
   ' qSht = Replace(Sheets(cSht).Name, """", """""") -- replace not in XL97
   qSht = Application.Substitute(Sheets(cSht).Name, """", """""")

Related - Alternatives   (#alternatives)

Unsorted selectable list of sheets, RClick on any of the direction arrows to left of sheet TABs, this will pop up an unsorted list of sheets, for a scrollable list goto bottom.

Sorted selectable list of Subroutines, Tools --> Macros; or Alt+F8, allows running or Editing of subroutine.

Sorted nonselectable list of Subroutines & dialogs, File --> Properties --> contents

Sorted list of Functions, use function wizard or paste function wizard [fx] --> User Function,   shows syntax, can show help if available, but does not provide a path to view code.

Populating a ListBox with Sheetnames: AN=582002850
to select:  also see Tom Ogilvy Feb 13 2000 in programming *******

John Walkenbach has created “Menu Maker” to create a menu from a spreadsheet.  The menu editor was dropped from XL97, and his “Menu Maker’ sure helps to fill in the gaps.  In fact it makes rearranging by categories on the “MenuSheet” spreadsheet much easier.  Once categorized on a menu you won't have to remember (look up) the VBA subroutine names as often, and the spreadsheet tells you where the code is.  If you have two by the same name in a workbook include the modulename as well.
   Custom Menus in Excel 97
   http://www.j-walk.com/ss/excel/tips/tip53.htm I repeated the category name on the right so I could sort it.  In other words I repeated in Column G the level 2 name used in column B.  Except if they stand by themselves at the top I used an asterisk.

My own major categories are:  selected high use individual macros, followed by categories of macros:  Create Test Data, Documentation (footings), Documentation Set, HTML creation, Information, Rearrange Data on Another Sheet, Reformat
Also note the alphabetical arrangement.

Using “Menu Maker’t makes things a lot easier.  Below is part of a coding example.  The the last line will add a 'separator' line - just add more menu items after this (Patrick Molloy, MISC 1999-10-06).  http://groups.google.com/groups?oi=djq&ic=1&selm=an_533386872
    Dim mnbNew As Menu

    Set mnbNew = MenuBars(xlWorksheet).Menus.Add("&Options")
    mnbNew.MenuItems.Add "Run &Utility", "Show_Form"
    mnbNew.MenuItems.Add "-"
More complete examples can be found in the Menu links above, and in the macros within John’s “Menu Maker”.

Outline Numbers (#outline)

Nothing on this page involves outline numbering, but some people interested in Table of Contents title might be interestd in outline numbers and sorting.  see page on sorting TCP/IP numbers.

Page Numbering   (#PageNumbers)

Nothing on this page involves page numbering, but with a table of Contents, if one had page numbers, they might want a collection of page numbers {1,2,3,5,6,8,9,10} to look like 1-3,5,6,8-10 with only 3 or more numbers joined, instead of 1-3,5-6,8-10.  [ref.]
Also see Toolbars, Custom Buttons and Menus.  Some of these topics are inter-related.
Also see Barhopper -- Listing of Menu Items
Q159619 -- XL97: Sample Macros to Control Menus and Submenus
Q271856 -- XL2000: Hyperlink Does Not Work When Pasted or Imported
http://home.enitel.no/exceltips/exceltips/
For macros containing examples (Excel5/95 and Excel97 and later) on how to create and modify menus.  Look in VBA part 2 CommandBars. -- Ole P. Erlandsen
Command and Menu Bars -- Charlie Kindschi, Microsoft Corporation
MSKB 830502 - How to customize menus and menu bars in Excel
-- replaces DP1758 (XL95), DP2586 (XL97) and hopefully also these articels also discontinued:  Q141688, Q166755 WE1183.
Menus and Command Bars (broken, try Build an Excel Add-In 6 – Interface for 2003, Jon Peltier
See note at top of page concerning location of coding for this page.

If not familiar with installation and use of macros, see Getting Started with Macros and User Defined Functions
 

An auxiliary page on how to Build a Summary Sheet for sheets that have exactly the same consistent format.  I realized that my Build Table of Contents (this page) is more oriented to the mechanics of maintaining a workbook.  Building a Summary Sheet relates more to actual usage and ease of maintaining a summary sheet.

The listing created by BuildTOC has been sorted to make it easy to find each sheet.  The SortALLsheets macro is included above. 

Gary Brown gives you a choice of ascending or descending sorts and has rehidden the hidden sheets both of which you normally don't see. In fact I don't recall seeing provision for either in previously posted solutions -- guess I just don't like hidden things, and was delighted that unhiding hidden sheets was a byproduct of other solutions, and may not be production oriented to those who hid them in the first place -- here is Gary’s code for WorksheetSort() <ejxjzW39$GA.276@cppssbbsa05>.

Not related to anything on this page but the word hidden, to make sure all rows are not hidden you can use something like:
      Worksheets("My First Sheet").Rows.Hidden=False

Other sorts:  Sorting Sheets in a Workbook, also see Q105069

Making a TOC in MS Word is described in Woody’s Office Watch (28 July 1999, Vol 4 No 31), you can also make an Index but you'll have to look in Help. /* formerly http://www.wopr.com/wow/wowv4n31.html */ [archive]

Documentation Listings on Site

Related tips from John Walkenbach’s site, concerning menus and sheets:

Related pages on Chip Pearson’s site

Cell Comments   Cell Comment

Create a file showing cell comments in a book, and view results with your web browser.

Faceid,

John Green has a CBlist addin in the MVP area of Steve Bullen’s site, to create into empty sheets: 1) list of command bars with it’s listable controls (Caption, Type, Face Image, Faceid), 2) Face Images and Faceids, 3) command bars and buttons (subset of 1).

Fonts (fontlist),

Steve Bullen has a GetFonts.zip on his site to list the Windows installed fonts.

A listing of fonts using HTML provides a faster approach.  http://www.bitstorm.org/fontlist/

John Walkenbach has a tip on creating a list of installed fonts.

More information on fonts on my formulas page, and on my "a href="fonts.htm">fonts page along with additional references.

Formulas and Formats

See my Formula page to expose the Formula used in another cell or the Format used another cell.  Also has lots of examples of cell formats to help you create your own custom format.

Hyperlinks

Most of this page is about hyperlinks, but haven't been able to find at place to include the following items.

Printers

Q166008 - ACC: Enumerating Local and Network Printers
http://support.microsoft.com/default.aspx?scid=kb;en-us;q166008

Sheets and Cell, addressing, reference

Sheets and Cells

Web Pages – Table of Contents for Web Pages   (#webpages)

Firefox users can see a Table of Contents at anytime for pages with H1-Hn headings by installing an extension for sidebar viewing, or a bookmarklet to create a secondary statusbar dropdown list. (see Document Map)

Other Documentation, or Organization Information (#docinfo).


This page was introduced on August 15, 1999. 

[My Excel Pages -- home]    [INDEX to my site and the off-site pages I reference] 
[Site Search -- Excel]     [Go Back]    [Return to TOP


Excel questions not directly concerning my web pages are best directed to newsgroups such as news://msnews.microsoft.com/microsoft.public.excel.misc where Excel users all around the clock from at least 6 continents ask and answer Excel questions.  Posting suggestions and netiquette.  More information on newsgroups and searching newsgroups.    Google Usenet Advanced Search


Please send your comments concerning this web page to: David McRitchie send email comments


Copyright © 1997 - 2014,  F. David McRitchie,  All Rights Reserved