This forum has been moved to TeachExcel.com
Ask all future questions in the New Excel Forum.
ExcelKey
Option Explicit
Option Base 0
Private Sub ChangeHyperLinks()
Const OldSheetName As String = "Old Name"
Const NewSheetName As String = "New Name"
Dim Ws As Worksheet
Dim Hlink As Hyperlink
Dim SplitName() As String
Set Ws = ActiveSheet
For Each Hlink In Ws.Hyperlinks
With Hlink
SplitName = Split(.SubAddress, "!")
If UBound(SplitName) > 0 Then
If InStr(1, .SubAddress, OldSheetName, vbTextCompare) Then
.SubAddress = "'" & NewSheetName & "'!" & SplitName(1)
End If
End If
End With
Next Hlink
End Sub
Private Sub ChangeHyperLinks()
' Set NewSheetName same as OldSheetName to effect no change
Const OldSheetName As String = "Sheet2"
Const NewSheetName As String = "Sheet2"
' Keep the old or new address BLANK to effect no change
Const OldAddress As String = ""
Const NewAddress As String = ""
Dim Ws As Worksheet
Dim Hlink As Hyperlink
Dim SplitName() As String
Dim Changed As Boolean
Set Ws = ActiveSheet
If Len(OldSheetName) = 0 Or Len(NewSheetName) = 0 Then Exit Sub
For Each Hlink In Ws.Hyperlinks
Changed = False
With Hlink
SplitName = Split(.SubAddress, "!")
If UBound(SplitName) > 0 Then
If InStr(1, SplitName(0), OldSheetName, vbTextCompare) Then
If StrComp(OldSheetName, NewSheetName, vbTextCompare) Then
SplitName(0) = "'" & NewSheetName
Changed = True
End If
End If
If StrComp(Trim(SplitName(1)), OldAddress, vbTextCompare) = 0 _
And Len(OldAddress) And Len(NewAddress) Then
SplitName(1) = NewAddress
Changed = True
End If
If Changed Then .SubAddress = SplitName(0) & "!" & SplitName(1)
End If
End With
Next Hlink
End Sub
Return to General Excel Questions
Users browsing this forum: No registered users and 243 guests