I have cells which contain a hyperlink which i have now given a friendly name.
Before i had a VBA that would check the hyperlink as a path and depending on its return format that cell. Now the VBA wont work as the friendly name is part of that string.
I have multiple cells with variable length friendly names so i can't just exclude a certain number of characters.
Is there a way to either reference the hyperlink path or copy the hyperlink to another cell and just return its path ?
Hyperlink Formula : =HYPERLINK(CONCATENATE(".\..\B. Target Documentation\",$B2,"\01_Reports\","E050048","-TRR-",$Z2,"-",TEXT(AH2,"yymmdd"),"-",$B2,".pdf"), $B2&" TRR")
Check hyperlink VBA :
Before i had a VBA that would check the hyperlink as a path and depending on its return format that cell. Now the VBA wont work as the friendly name is part of that string.
I have multiple cells with variable length friendly names so i can't just exclude a certain number of characters.
Is there a way to either reference the hyperlink path or copy the hyperlink to another cell and just return its path ?
Hyperlink Formula : =HYPERLINK(CONCATENATE(".\..\B. Target Documentation\",$B2,"\01_Reports\","E050048","-TRR-",$Z2,"-",TEXT(AH2,"yymmdd"),"-",$B2,".pdf"), $B2&" TRR")
Check hyperlink VBA :
VBA Code:
Public Sub CheckHyperlink()
Dim strLink As String
Dim rCell As Range
Dim rRng As Range
Dim LR As Integer
Dim LastTarget As Range
Dim File As String
Dim File2 As String
Application.ScreenUpdating = False
FirstColumn
LastColumn
Worksheets("ListOfPoints").Activate
Range(FirstColNr & "2").Select
Set LastTarget = Selection.End(xlDown).End(xlDown).End(xlUp)
LR = LastTarget.Row
Set rRng = Sheets("ListOfPoints").Range(FirstColNr & "2:" & LastColNr & LR)
'Set rRng = Sheets("ListOfPoints").Range("AL2:AQ3")
For Each rCell In rRng.Cells
rCell.Select
'Selection.Hyperlinks.Add Anchor:=Selection, Address:=Selection
strLink = ThisWorkbook.Path & rCell.Text
If Dir(strLink) <> vbNullString Then
Selection.Font.Color = vbBlue
'File = Dir(strLink)
'MsgBox File
ElseIf Dir(strLink, vbDirectory) <> vbNullString Then
Selection.Font.Color = vbBlue
Else
Selection.Font.Color = vbRed
End If
Next rCell
Range(FirstColNr & "2").Select
Application.ScreenUpdating = True
End Sub