hyperlink open location

[DH888]

How can i get hyperlinks to locations within the same workbook to open with the linked cell at the top of the window instead of the bottom
Thanks

 

[Domenic]

If your hyperlinks are located all within the same sheet, you can use the Worksheet_FollowHyperlink event. Right click the sheet tab for the sheet containing the hyperlinks, select View Code, and then copy/paste the following code into the code module for the sheet...

[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Worksheet_FollowHyperlink([COLOR=darkblue]ByVal[/COLOR] Target [COLOR=darkblue]As[/COLOR] Hyperlink)
    [COLOR=darkblue]Dim[/COLOR] strSheetName [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] strRef [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    strSheetName = Replace(Split(Target.SubAddress, "!")(0), "'", "")
    strRef = Split(Target.SubAddress, "!")(1)
    Application.Goto Reference:=Sheets(strSheetName).Range(strRef), Scroll:=[COLOR=darkblue]True[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

If your hyperlinks are located throughout the workbook, you can use the Workbook_SheetFollowHyperlink event. In the Visual Basic Editor, and under the Project Explorer window, right-click ThisWorkbook for the workbook containing your hyperlinks, select View Code, and copy/paste the following code into the code module for the workbook...

[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Workbook_SheetFollowHyperlink([COLOR=darkblue]ByVal[/COLOR] Sh [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR], [COLOR=darkblue]ByVal[/COLOR] Target [COLOR=darkblue]As[/COLOR] Hyperlink)
    [COLOR=darkblue]Dim[/COLOR] strSheetName [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] strRef [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    strSheetName = Replace(Split(Target.SubAddress, "!")(0), "'", "")
    strRef = Split(Target.SubAddress, "!")(1)
    Application.Goto Reference:=Sheets(strSheetName).Range(strRef), Scroll:=[COLOR=darkblue]True[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Hope this helps!

 

[DH888]

The hyperlinks are all in an index tab they point to other sheets within the same workbook.

Is that what you mean by this
If your hyperlinks are located throughout the workbook

It's unclear to me if you mean the actual hyperlinked cells or the destinations the linked cells actually send you to.

Thanks for the solution I'll try it once I know what you meant by this statement.

 

[Domenic]

I meant the actual hyperlinked cells (the cells containing the hyperlinks). So since you say that the hyperlinks are all in an index tab, use the first one, the Worksheet_FollowHyperlink event.

 

[DH888]

It gives me an error

Run-time error '9':

Subscript out of range

 

[Domenic]

Does this help?

[COLOR=darkblue]Private[/COLOR] [COLOR=darkblue]Sub[/COLOR] Worksheet_FollowHyperlink([COLOR=darkblue]ByVal[/COLOR] Target [COLOR=darkblue]As[/COLOR] Hyperlink)

    [COLOR=darkblue]Dim[/COLOR] strSheetName [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] strRef [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    
    strSheetName = Split(Target.SubAddress, "!")(0)
    [COLOR=darkblue]If[/COLOR] Left(strSheetName, 1) = "'" And Right(strSheetName, 1) = "'" Then
        strSheetName = Mid(strSheetName, 2, Len(strSheetName) - 2)
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    strSheetName = Replace(strSheetName, "''", "'")
    
    strRef = Split(Target.SubAddress, "!")(1)
    
    Application.Goto Reference:=Sheets(strSheetName).Range(strRef), Scroll:=[COLOR=darkblue]True[/COLOR]
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]