VBA Create Hyperlink when additional data is added for each row based on cell value

[mielkew]

Hello Guys,

I was hoping someone will be able to help me create a VBA code that will automatically change Column D to a clickable hyperlink based on cell value in Column U for each Specific Sheet whenever additional data is added in the worksheet. (Worksheet.Change event)

I attached my current excel workbook which is connected to another sheets using PowerQuery to pull the data from another workbook. Currently, I have the hyperlink formula in Column "Aconex Hyperlink", which often being deleted by end user of this excel file. I would like the VBA code to fix it by having the hyperlink embedded in the Column D (Document No.) which the end user will not be able to change.

IAppreciate any input from anyone.

Thanks,
Mielkew

[大灰狼1976]

Hi Mielkew!
Please refer to the following code.


Sub addHyperlinks()Dim r&, i&
With Sheets("Technical")
r = .Cells(Rows.Count, "d").End(3).Row
For i = 12 To r
.Hyperlinks.Add Anchor:=.Cells(i, "d"), Address:=.Cells(i, "u")
Next i
End With
End Sub

[大灰狼1976]

Hi Mielkew!
Please refer to the following code.


Sub addHyperlinks()Dim r&, i&
With Sheets("Technical")
r = .Cells(Rows.Count, "d").End(3).Row
For i = 12 To r
.Hyperlinks.Add Anchor:=.Cells(i, "d"), Address:=.Cells(i, "u")
Next i
End With
End Sub

--Okami

[snb]

Sub M_snb()
for each it in sheets("Technical").columns(4).specialcells(2)
if it.row >11 then .Parent.Hyperlinks.Add it, it.offset(,17)
Next
End Sub

[mielkew]

Sub M_snb()
for each it in sheets("Technical").columns(4).specialcells(2)
if it.row >11 then .Parent.Hyperlinks.Add it, it.offset(,17)
Next
End Sub

Thanks, can this code be applied to Private Sub Worksheet_Change? I have the below code, can you help me change the target range from C12: LastRow as my table heading start from Row 11



Private Sub Worksheet_Change(ByVal Target As Range)

Dim cell As Range
Dim tmp As String

If Intersect(Range("C:C"), Target) Is Nothing Then Exit Sub

For Each cell In Target
If cell.Column = 3 Then
Application.EnableEvents = False
tmp = cell.Value2
cell.Parent.Hyperlinks.Add _
Anchor:=Cells(cell.Row, 3), _
Address:=Cells(cell.Row, 14), _
TextToDisplay:=tmp
Application.EnableEvents = True

End If

Next cell

End Sub


This code does exactly what I need, with the exception of Row C11 the column header is converted with hyperlink as well, but overall it's working as needed.

Also, if the font and style can be changed will be more perfect

[snb]

It's not efficient ( not to say counterproductive) to add hyperlinks to a range when only 1 value in that range has been changed.

[Paul_Hossler]

I didn't follow some of the requirements. but maybe something like this

Not sure why you used a temp string to hold the value of col C cell to display. Did you mean the col N cell? I used that below



Option Explicit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rColC As Range
Dim rCell As Range
Dim sTemp As String




Set rColC = Intersect(Range("C:C"), Target, UsedRange)
If rColC Is Nothing Then Exit Sub




Application.EnableEvents = False
For Each rCell In rColC.Cells
With rCell
If .Row > 11 Then ' skip header row
If Len(.Value) = 0 Then ' delete hyperlink if cell is cleared
.Hyperlinks.Delete
.Font.Bold = False ' clear formatting
.Font.Italic = False
.Font.Underline = False
Else
sTemp = .Offset(0, 11).Value2
.Parent.Hyperlinks.Add _
Anchor:=rCell, Address:="", SubAddress:="'" & .Parent.Name & "'!" & .Offset(0, 11).Address, TextToDisplay:=sTemp
.Font.Bold = True
.Font.Italic = True
End If
End If
End With
Next


Application.EnableEvents = True
End Sub