Update hyperlinks with an excel Macro

Question

enter image description hereI'm trying to add an extension to all embedded hyperlinks on an Excel worksheet. I recorded a macro by doing one cell at a time but is not efficient. Can someone help me streamline the macro so that it knows to look at all hyperlinks, open, and insert additional information at the end tail of the existing hyperlink.

Sub Macro5()
'
' Macro5 Macro
' test
'
' Keyboard Shortcut: Ctrl+Shift+H
'
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "?u=76208058&auth=true"
    Range("C2").Select
    Selection.Hyperlinks(1).Address = _
        "https://www.linkedin.com/learning/teaching-techniques-classroom-management?u=76208058&auth=true"
    Range("C3").Select
    Selection.Hyperlinks(1).Address = _
        "https://www.linkedin.com/learning/learning-how-to-increase-learner-engagement?u=76208058&auth=true"
    Range("C4").Select
    Selection.Hyperlinks(1).Address = _
        "https://www.linkedin.com/learning/teaching-with-technology?u=76208058&auth=true"
End Sub

Answer 1

Add String to Hyperlinks

• The first code changes the hyperlink addresses of all cells in the specified worksheet, while the second changes only the hyperlink addresses in a specified column of the worksheet.
• Adjust the values in the constants section appropriately.
• The If statement checks if the current hyperlink has already been modified.

The Code

Option Explicit

' For the whole sheet:
Sub addTailSheet()

' Keyboard Shortcut: Ctrl+Shift+H

    Const SheetName As String = "Sheet1"
    Const TailCell As String = "H1"

    Dim ws As Worksheet
    Dim hyp As Hyperlink
    Dim Tail As String

    Set ws = ThisWorkbook.Worksheets(SheetName)

    With ws
        Tail = .Range(TailCell).Value
        For Each hyp In .Hyperlinks
            If Right(hyp.Address, Len(Tail)) <> Tail Then
                hyp.Address = hyp.Address & Tail
            End If
        Next
    End With

    MsgBox "Hyperlinks modified."

End Sub

' For a column:
Sub addTailColumn()

' Keyboard Shortcut: Ctrl+Shift+H

    Const SheetName As String = "Sheet1"
    Const TailCell As String = "H1"
    Const TailColumn As Variant = "C"  ' e.g. "C" or 3

    Dim ws As Worksheet
    Dim hyp As Hyperlink
    Dim Tail As String

    Set ws = ThisWorkbook.Worksheets(SheetName)

    With ws.Columns(TailColumn)
        Tail = .Parent.Range(TailCell).Value
        For Each hyp In .Hyperlinks
            If Right(hyp.Address, Len(Tail)) <> Tail Then
                hyp.Address = hyp.Address & Tail
            End If
        Next
    End With

    MsgBox "Hyperlinks modified."

End Sub