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
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
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")
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")
Views 4,375
Downloads 1,352
CodeID
DB ID