CellSave_Hyperlink

Creates a hyperlink to URL or to cell inside a cell in Excel VBA (or delete it).
This is Hyperlink as Insert > Hyperlink and not as Hyperlink function.
Option to add hyperlink to online link, to a cell giving full cell address like [workbook.xlsx]Sheet1!A1, or as parts of workbook, worksheet and cell address.
If none of URL, FullAddress or CellAddress is given, that hyperlink will be deleted

More examples:
Puts link in Sheet2!G7 of this workbook to certain cell in certain workbook/worksheet
CellSave_Hyperlink "G7", , "[Workbook1.xlsb]Sheet5!D3:D6", , , , "Sheet2", "Main.xlsb", "Client List"

Edit 2024-03-22: Found issue and fix in adding hyperlink to URL

CodeFunctionName

What is this?

Public

Tested

Original Work

Function CellSave_Hyperlink(inCell_Addr, Optional ToURL = "", _
    Optional ToCell_FullAddress = "", _
    Optional ToCell_Address = "", Optional ToCell_Sheet = "This", Optional ToCell_WB = "This", _
    Optional InCell_Sheet = "This", Optional InCell_WB = "This", _
    Optional HCaption = "", Optional HTip = "")
    ' Line below will add hyperlink in a cell
    '    Not Hyperlink function, but the actual hyperlink
    ' Sheet1.Hyperlinks.Add Sheet1.Range("D5").Offset(I, 0), "", "'" & SheN & "'!A1", , SheN
    '
    If InCell_WB = "This" Then InCell_WB= ThisWorkbook.Name
    If ToCell_WB = "This" And InCell_WB > "" Then ToCell_WB = InCell_WB
    If ToCell_WB = "This" Then ToCell_WB = ThisWorkbook.Name
    If InCell_Sheet = "This" Then InCell_Sheet = Workbooks(InCell_WB).ActiveSheet.Name
    If ToCell_Sheet = "This" And InCell_Sheet > "" Then ToCell_Sheet = InCell_Sheet
    If ToCell_Sheet = "This" Then ToCell_Sheet = Workbooks(ToCell_WB).ActiveSheet.Name
    HRef1 = ""
    HRef2 = ""
    AddH = 0
    If ToURL = "" And ToCell_Address = "" And ToCell_FullAddress = "" Then
        ' Caller asked to remove hyperlink
        Workbooks(InCell_WB).Worksheets(InCell_Sheet).Range(inCell_Addr).Clear
    Else
        AddH = 1
        If ToURL > "" Then HRef1 = ToURL
        If ToCell_FullAddress > "" Then HRef2 = ToCell_FullAddress
        If ToCell_Address > "" Then HRef2 = "'[" & ToCell_WB & "]" & ToCell_Sheet & "'!" & ToCell_Address
        If HCaption = "" And HRef1 > "" Then HCaption = HRef1
        If HCaption = "" And HRef2 > "" Then HCaption = HRef2
    End If
    If AddH = 1 Then
        Workbooks(InCell_WB).Worksheets(InCell_Sheet).Hyperlinks.Add Workbooks(InCell_WB).Worksheets(InCell_Sheet).Range(inCell_Addr), _
            HRef1, HRef2 , HTip, HCaption
    End If
End Function

inCell_Addr, Optional ToURL, Optional ToCell_FullAddress, Optional ToCell_Address, Optional ToCell_Sheet, Optional ToCell_WB, Optional InCell_Sheet, Optional InCell_WB, Optional HCaption, Optional HTip

Put link in cell G4 that jumps to A1 in same sheet
    CellSave_Hyperlink "G4", , , "A1"
Put link in cell G5 that jumps to cell A1 in sheet Main in same workbook, with caption of "Back"
    CellSave_Hyperlink "G5" , , , "A1", "Main", , , , "Back"
Puts link in cell G6 of sheet "Cmd" that jumps to website VBA.me, link name is "About" and screen tip is "About Programmer"
    CellSave_Hyperlink "G6", "http://VBA.me", , , , , "Cmd", , "About", "About Programmer")