Create Hyperlink, when data is added to row, based on cell value - excel

Question

I have the below requirements:
Add hyperlink in Col A using address in Col D (Web Link), retain Col A display text and tooltip Col D file path address.
Add hyperlink in Col C using file path address in Col E, Col A and Col B (for Local network location). Retain Col C display text and Tooltip Col E, Col A and Col B file path address. The file naming follows this sequence "Data-002 Rev 00.pdf".
Add hyperlink in Col F "View File Local", same tooltip in Col C.
If Col E is blank Col C should not Add hyperlink in Col C and should retain the font style of Col C and Add text in Col F "File Not Found".
Retain all the Hyperlinks upon refresh of the table and only create new hyperlinks for the cell not having hyperlinks.
Since I am extracting the data from another table, the above order of documents might change, example "Data-002" might be in the 2nd Row when the data is refreshed because “Data-001” will be added after the refresh.
I don't know whether the VBA hyperlinks will retain its original linked address upon refresh, if yes, then Item 5 requirement is not required.
My end-users tend to delete the hardcoded hyperlink formulas in Col F. I want the hyperlink fixed so they cannot delete or modify.
The code below does most of the Hyperlink.Add but it keeps going for the entire rows and sheets in the workbook which causes the Excel file to freeze.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rColA As Range
Dim rColName As String
Dim LastRow As Long
Dim rColC As Range
Dim rColName1 As String
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Set rColA = Range("A1:A" & LastRow)
If Intersect(Range("A1:A" & LastRow), Target) Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each rColA In rColA
If rColA.Column = 1 Then
rColName = rColA.Value2
rColA.Parent.Hyperlinks.Add _
Anchor:=Cells(rColA.Row, 1), _
Address:=Cells(rColA.Row, 4), _
TextToDisplay:=rColA
rColA.Font.Size = 10
rColA.Font.Underline = False
End If
Next rColA
Set rColC = Range("C1:C" & LastRow)
If Intersect(Range("C1:C" & LastRow), Target) Is Nothing Then Exit Sub
For Each rColC In rColC
If Cells(rColC.Row, 5) <> "" Then
If rColC.Column = 3 Then
rColName1 = rColC.Value2
rColC.Parent.Hyperlinks.Add _
Anchor:=Cells(rColC.Row, 3), _
Address:=Cells(rColC.Row, 5) & Cells(rColC.Row, 1) & " Rev " & Cells(rColC.Row, 2) & ".pdf", _
TextToDisplay:=rColName1
rColC.Font.Size = 10
rColC.Font.Underline = False
End If
End If
Next rColC
Application.EnableEvents = True
End Sub

Answer 1

Try this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long, rng As Range, c As Range, addr
LastRow = Me.Cells(Me.Rows.Count, 1).End(xlUp).Row
On Error GoTo haveError
'see if any cells of interest have changed
Set rng = Application.Intersect(Target, Me.Range("A1:A" & LastRow & ",C1:C" & LastRow))
If Not rng Is Nothing Then
Application.EnableEvents = False
For Each c In rng.Cells
Select Case c.Column 'select link address based on column
Case 1: addr = c.EntireRow.Columns("D")
Case 3: addr = Cells(c.Row, "E") & Cells(c.Row, "A") & " Rev " & Cells(c.Row, "B") & ".pdf"
End Select
c.Parent.Hyperlinks.Add Anchor:=c, Address:=addr, TextToDisplay:=c.Value2
c.Font.Size = 10
c.Font.Underline = False
Next c
Application.EnableEvents = True
End If
Exit Sub 'don't run into the error handler
haveError:
Application.EnableEvents = True 'make sure an error doesn't leave events turned off
End Sub
EDIT: I think this is probably closer to what you want. It'd easier just to treat each row as a unit, rather than try to track changes per-cell and only update certain links.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long, rng As Range, rw As Range, addr, txt
LastRow = Me.Cells(Me.Rows.Count, 1).End(xlUp).Row
On Error GoTo haveError
'see if any cells of interest have changed
Set rng = Application.Intersect(Target.EntireRow, Me.Range("A1:F" & LastRow))
If Not rng Is Nothing Then
Application.EnableEvents = False
'loop over changed rows
For Each rw In rng.Rows
Me.Hyperlinks.Add anchor:=rw.Columns("A"), _
Address:=rw.Columns("D").Value, _
TextToDisplay:=rw.Columns("A").Value2
Me.Hyperlinks.Add anchor:=rw.Columns("C"), _
Address:=rw.Columns("E") & rw.Columns("A") & " Rev " & rw.Columns("B") & ".pdf", _
TextToDisplay:=rw.Columns("C").Value2
If Len(rw.Columns("E").Value) > 0 Then
Me.Hyperlinks.Add anchor:=rw.Columns("F"), _
Address:="{whatever is the path here}", _
TextToDisplay:="View file local"
Else
rw.Columns("E").Value = "File not found"
End If
With rw.Range("A1,C1,F1") 'Range() is *relative* to rw
.Font.Size = 10
.Font.Underline = False
End With
Next rw
Application.EnableEvents = True
End If
Exit Sub 'don't run into the error handler
haveError:
Application.EnableEvents = True 'make sure an error doesn't leave events turned off
End Sub