Macro to Copy Hyperlink from Another Sheet [closed]
Here is the fixed code. I also added an If so if the original link cell was blank it would remove the hyperlink in the new sheet because when you resorted the information the cells that corresponded to blanks on the other sheet still had the old hyperlink from the last time the macro applied.
Sub UpdateLinks_Click()
' Copy the hyperlink from Modeling Tracker Sheet and apply it to the Directory
Dim i As Integer
For i = 7 To 1007
If Worksheets("Modeling Tracker").Range("S" & i).Value > "" Then
Dim newLink As String
If Worksheets("Modeling Tracker").Range("S" & i).Hyperlinks.Count = 1 Then
newLink = Worksheets("Modeling Tracker").Range("S" & i).Hyperlinks(1).Address ' Get the link from the Modeling Tracker
Worksheets("Directory").Range("B" & i).Hyperlinks.Add Anchor:=Worksheets("Directory").Range("B" & i), Address:=Worksheets("Directory").Range("B" & i) 'turns it to a link
Worksheets("Directory").Range("B" & i).Hyperlinks(1).Address = newLink 'replace it with newLink
End If
End If
If Worksheets("Modeling Tracker").Range("S" & i).Value = "" Then
Worksheets("Directory").Range("B" & i).Hyperlinks.Delete
End If
Next i
Worksheets("Directory").Range("B7:B1007").Font.Color = vbBlack ' this to is avoid the auto hyperlink format
Worksheets("Directory").Range("B7:B1007").Font.Underline = False ' this is to avoid the auto-hyperlink format
End Sub