Fix Hyperlinks

[sspatriots]

Good evening,

I found the code below online that is supposed to change the hyperlink file paths to a selected range. Every time I use it, only the cell I select prior to selecting a range gets updated. Just trying to figure out what I'm missing here.

Sub ChangeHyperlinks()

Dim cell As Range

For Each cell In Selection

If cell.Hyperlinks.Count > 0 Then

cell.Hyperlinks(1).Address = Replace(cell.Hyperlinks(1).Address, "..\..\drives\rManufacturing\00-Commercial & Group 2 PO Archive\2023", "H:\Jobs\00 PO ARCHIVE\2023")

End If

Next cell

End Sub

 

[Fluff]

Try it like

Sub ChangeHyperlinks()

Dim cell As Range

For Each cell In Selection
   With cell.Hyperlinks
      If .Count > 0 Then
         cell.Hyperlinks(.Count).Address = Replace(cell.Hyperlinks(.Count).Address, "..\..\drives\rManufacturing\00-Commercial & Group 2 PO Archive\2023", "H:\Jobs\00 PO ARCHIVE\2023")
      End If
   End With
Next cell

End Sub

With test data I set up the 1st cell is a count of 1 but all the others are 2, even though you can only have 1 hyperlink per cell.

 

[Georgiboy]

That changes all of the links as does the previous codes but if you add in the 'TextToDisplay' line it only seems to actually change the first two links for TextToDisplay:

Sub ChangeHyperlinksFluff()
    Dim cell As Range

    For Each cell In Selection
       With cell.Hyperlinks
          If .Count > 0 Then
             cell.Hyperlinks(.Count).Address = Replace(cell.Hyperlinks(.Count).Address, "..\..\drives\rManufacturing\00-Commercial & Group 2 PO Archive\2023", "H:\Jobs\00 PO ARCHIVE\2023")
             cell.Hyperlinks(.Count).TextToDisplay = "H:\Jobs\00 PO ARCHIVE\2023"
          End If
       End With
    Next cell
End Sub

Strange how it does not action the TextToDisplay for every cell.

 

[Fluff]

This works for me

Sub ChangeHyperlinks()

Dim cell As Range
Dim Txt As String

For Each cell In Selection
   With cell.Hyperlinks
      If .Count > 0 Then
         Txt = Replace(cell.Hyperlinks(.Count).Address, "..\..\drives\rManufacturing\00-Commercial & Group 2 PO Archive\2023", "H:\Jobs\00 PO ARCHIVE\2023")
         cell.Hyperlinks(.Count).Address = Txt
         cell.Hyperlinks(.Count).TextToDisplay = Txt
      End If
   End With
Next cell

End Sub

 

[sspatriots]

This works for me

Sub ChangeHyperlinks()

Dim cell As Range
Dim Txt As String

For Each cell In Selection
   With cell.Hyperlinks
      If .Count > 0 Then
         Txt = Replace(cell.Hyperlinks(.Count).Address, "..\..\drives\rManufacturing\00-Commercial & Group 2 PO Archive\2023", "H:\Jobs\00 PO ARCHIVE\2023")
         cell.Hyperlinks(.Count).Address = Txt
         cell.Hyperlinks(.Count).TextToDisplay = Txt
      End If
   End With
Next cell

End Sub

How would I make that work for just updating the hyperlink to each cell? I does seem to create all of the links, but it replaces what was in my cell range with the text of the hyperlinks. I tried remarking that last line in there and I'm back to where I started. Thanks.

 

[Fluff]

If you don't want to change the display text use the code from post#11

 

[jkpieterse]

The interesting thing is that activesheet.hyperlinks.count reports only 2 hyperlinks.

 

[Georgiboy]

@jkpieterse Same for me, quite strange.

 

[Georgiboy]

Ahh, I think it is to do with the way the links are added to the sheet, if they are pasted in a block or dragged down then Excel seems to think that the block of links are all one link in one range.

I just added 5 links seperately with CTRL-K and it changed them all at once, with a activesheet.hyperlinks.count of 5.

So there is the starting link address, then there is the address of the first link of the block that were copied, and that's it, the rest do not have their own range.

 

[sspatriots]

I went back and tried the code on post #11. For some reason it isn't updating all the links. It skips about half of them. The ones that I have highlighted the adjacent cell in yellow are the only ones that updated. All I'm doing is moving files from one place on the server to another. So I'm having to change the hyperlink file paths. This is a sample from about 300 rows. When I run your code from post #13 I see the full text of every hyperlink in that second column below and they all work. For some, reason the code in post #11 is skipping cells whereas the code in post #13 does swap the file path in all of the selected range.

 

[Fluff]

In that case use the code from post#13 but remove this line

cell.Hyperlinks(.Count).TextToDisplay = Txt