Hyperlink SubAddresses lost during Save As

[xstatic414]

With Excel 2003: I have a number of hyperlinks in a menu that self-reference to initiate a macro using:

[VBA]Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink).
[/VBA]
So a hyperlink clicked in cell "B2" references to "B2" to run a macro. This works great. The problem is that when I SaveAs using vba with:

[VBA]ActiveWorkbook.SaveAs Filename:= _
(SupplierFileName) ' _
', FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
'ReadOnlyRecommended:=False, CreateBackup:=False[/VBA]

the hyperlink SubAddresses all revert to "A1". When I physically SaveAs a file with F12, the menus all work fine. The links also break when copying a sheet to another workbook

So, if any kind person can tell me how to SaveAs or Copy so they don't break, that would be wonderful.

As a workaround, I recorded a macro to physically go to each broken link and fix it, but this means a new macro for each different sheet layout. Here's the short version of what I have.

[VBA]Sub Fix_Macros()

Range("B2").Select
Selection.Hyperlinks(1).SubAddress = "B2"
Range("C2").Select
Selection.Hyperlinks(1).SubAddress = "C2"
' and so on for another 15 links
End Sub[/VBA]

This does work, but I know that a more elegant version exists using hyperlinks.count , but I'm a hopeless programmer and can't seem to redesign the few examples I can find. So 6 hours later , I ask you for help with either the workaround or the saveas fix.

THANKS, Kevin

[lucas]

With Excel 2003: I have a number of hyperlinks in a menu that self-reference to initiate a macro using:

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink).

So a hyperlink clicked in cell "B2" references to "B2" to run a macro.

Can you give us a sample workbook demonstrating what you are doing here......it would make it much easier to understand your problem.

[xstatic414]

Okay, when preparing the attached workbook, I found out what is going wrong. It is actually when the sheetname is renamed, NOT the save, that the hyperlinks all re-SubAddressed to "A1". Any ideas?

[david000]

Change B2 and C2 to named ranges like, Link1 and Link2, then make those the subaddress for each cell. That worked for me.

[vba]
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)

Select Case Target.TextToDisplay

Case "Link 1"
Application.Run "Rename_Sheet"

Case "Link 2"
Application.Run "Rename_Sheet"

End Select
End Sub

[/vba]

[vba]
Sub Rename_Sheet()
With Sheet2
If .Name = "Name Changed" Then
.Name = "Original Name"
ElseIf .Name = "Original Name" Then
.Name = "Name Changed"
End If
MsgBox .Name
End With
End Sub

[/vba]

[xstatic414]

Seems so simple when someone else thinks of it! SOLVED with my thanks. Kevin

[lucas]

Kevin, be sure to mark your thread solved using the thread tools at the top of the page.