Find and replace portions of hyperlinks

[willow1985]

I have tried multiple VBA codes online but nothing seems to do the trick. What I would like is to find a portion of all hyperlinks in a spreadsheet (135 of them in column A) and replace them with something else.

The links are as follows:

Current Link:
\\Davinci-1\cdata\DEPARTMENT\Records\Material Data Safety Sheets\9D4A.pdf
Text to display: Chem 9D4A

What I would like it changed to:
\\DAVINCI-1\COMMON\MSDS Database\Material Safety Data Sheets\9D4A.pdf
Text to display: Chem 9D4A

File and text to display are to stay the same but the directory I would like changed.

Any help would be appreciated. Thank you

 

[Dave87]

with current link in cell A2, file name (incl ".pdf") in b2, in cell c2 try the following formula

=HYPERLINK(LEFT(A2,12)&"COMMON\MSDS Database\Material Safety Data Sheets\"&B2,"CHEM "&LEFT(B2,LEN(B2)-4))

(this assumes all documents are pdfs and not excel/word/powerpoint/pics etc)

 

[willow1985]

with current link in cell A2, file name (incl ".pdf") in b2, in cell c2 try the following formula

=HYPERLINK(LEFT(A2,12)&"COMMON\MSDS Database\Material Safety Data Sheets\"&B2,"CHEM "&LEFT(B2,LEN(B2)-4))

(this assumes all documents are pdfs and not excel/word/powerpoint/pics etc)

The file names vary in length and type. Some may be Chem 9D4A.pdf and some may be hydrolcil formula.pdf

All the names vary, which is why I thought a vba / find and replace solution might be the way to go.

I hope someone can help me, it will take a long time individually going through all of the hyperlinks.

Thank you

 

[Dave87]

can you post some sample data please

 

[Peter_SSs]

It is not clear whether all your cells in column A are hyperlinks or not. If all are then you could possible remove my check of Hyperlinks.Count, though it shouldn't hurt to leave it in.
I have assumed that you hyperlinks are not formula hyperlinks. That is, not like =HYPERLINK(link_location, [friendly_name])
So, you could try this.

Sub AlterHyperlinks()
  Dim c As Range
  Dim pos As Long
  Dim tmp As String
  
  Const sNewPath As String = "\\DAVINCI-1\COMMON\MSDS Database"
  
  For Each c In Range("A2", Range("A" & Rows.Count).End(xlUp))
    If c.Hyperlinks.Count > 0 Then
      tmp = c.Hyperlinks(1).Address
      pos = InStrRev(tmp, "\", InStrRev(tmp, "\") - 1)
      If pos > 0 Then c.Hyperlinks(1).Address = sNewPath & Mid(tmp, pos)
    End If
  Next c
End Sub

 

[willow1985]

Thank you very much for all of your help

 

[Peter_SSs]

You're welcome.