Hyperlink Renaming

Hello,

I was wondering if I could get some help with hyperlink validation renaming.

I currently have this working code:

Option Explicit

Sub AddHyperlinks()
Dim fName As String
Dim fRNG  As Range:     Set fRNG = Range("B2:B" & Rows.Count).SpecialCells(xlConstants)
Dim f     As Range
Dim fPath As String:    fPath = Range("D2")
Dim fType As String:    fType = Range("C2")

    For Each f In fRNG
        fName = Dir(fPath & f & fType)
        If fName <> "" Then
            Range("A" & f.Row).FormulaR1C1 = "=HYPERLINK(""" & fPath & f & fType & """, ""Link"")"
        Else
            Range("A" & f.Row) = "No Link"
        End If
    Next f

End Sub

What this code does is compare a list of hyperlinks which are named a number of digits to a file name using cells C2 and D2 in combination with the file names listed under col B.
If the hyperlink is valid, this program will keep the hyperlink active but rename the hyperlink name to "link"
If the hyperlink does not exist(does not point to a particular picture in the directory), it will disable the hyperlink and change the hyperlink name to "no link"

I was wondering if there was any way to keep the file name of the hyperlink and if the link does not exist, disable it change the hyperlink font color to black and make it not underlined.
This way the hyperlinks with photos are distinguished from the files without a photo.

I currently have the following code to hyperlink the file

=HYPERLINK($D$2 & B2 & $C$2, "B2")

As you can see, I have been naming the hyperlink the contents in B2
After this hyperlink validation code executes, I would like the contents of the hyperlink to still be named the contents in Col B


Thanks

Adding in a new variable to help with your link text in cell B2 as well, this should do it:

Option Explicit

Sub AddHyperlinks()
Dim fRNG  As Range:     Set fRNG = Range("B2:B" & Rows.Count).SpecialCells(xlConstants)
Dim f     As Range
Dim fName As String
Dim fPath As String:    fPath = Range("D2")
Dim fType As String:    fType = Range("C2")
Dim fText As String:    fText = Range("B2")

    For Each f In fRNG
        fName = Dir(fPath & f & fType)
        If fName <> "" Then
            Range("A" & f.Row).FormulaR1C1 = "=HYPERLINK(""" & fPath & f & fType & """, " & fText & ")"
        Else
            Range("A" & f.Row) = Clear
            Range("A" & f.Row) = fText
        End If
    Next f

Set fRNG = Nothing
End Sub

Sorry, my bad:

Range("A" & f.Row).Clear

Also, here's a version that uses the text IN COLUMN B as the link text.

Option Explicit

Sub AddHyperlinks()
Dim fRNG  As Range:     Set fRNG = Range("B2:B" & Rows.Count).SpecialCells(xlConstants)
Dim f     As Range
Dim fName As String
Dim fPath As String:    fPath = Range("D2")
Dim fType As String:    fType = Range("C2")

    For Each f In fRNG
        fName = Dir(fPath & f & fType)
        If fName <> "" Then
            Range("A" & f.Row).FormulaR1C1 = _
                "=HYPERLINK(""" & fPath & f & fType & """, """ & f.Text & """)"
        Else
            Range("A" & f.Row).Clear
            Range("A" & f.Row) = f.Text
        End If
    Next f

Set fRNG = Nothing
End Sub