CODEWITHSUNDEEP
excelvba
Lacer
Lacer

Reputation: 5958

excel VBA - extract URL from hyperlink with including # and after

The following code isn't extracting URLs past the "#"

The setup

URL1/2 in A1/2 then command/control + k to set hyperlink

example

A1 = URL1 = http://stackoverflow.com/hello

A2 = URL2 = http://stackoverflow.com/hello#world

Using VBA code below

=URL(A1) = Result = http://stackoverflow.com/hello (DESIRED)

=URL(A2) = Result = http://stackoverflow.com/hello (NOT DESIRED)

Desired:

A2 = http://stackoverflow.com/hello#world

Question

VBA code

Function URL(Hyperlink As Range)
  URL = Hyperlink.Hyperlinks(1).Address
End Function

Upvotes: 0

Views: 1023

Answers (3)

Robert Mearns
Robert Mearns

Reputation: 11986

Your function is accepting a range. If a range of more than one cell is used, with each cell containing a hyperlink. The hard coding of 1 will always only return the first hyperlink.

In the same way that you test for no hyperlinks, you may also want to test for more than one hyperlink.

Then decide what to return.

Here is code to return all the hyperlinks in a range.

Sub test()
Dim Example1 As String
Dim Example2 As String
Dim Example3 As String

Example1 = URL(ActiveWorkbook.ActiveSheet.Range("A1"))
Example2 = URL(ActiveWorkbook.ActiveSheet.Range("A2"))
Example3 = URL(ActiveWorkbook.ActiveSheet.Range("A1:A3"))

MsgBox "Example 1:" & vbCrLf & Example1 & vbCrLf & "Example 2:" & _
        vbCrLf & Example2 & vbCrLf & "Example 3:" & vbCrLf & Example3

End Sub


Function URL(hyperlink As Range) As String
'Returns all hyperlinks in a range as text

If hyperlink.Hyperlinks.Count = 0 Then Exit Function
    
    For a = 1 To hyperlink.Hyperlinks.Count
        If hyperlink.Hyperlinks(a).SubAddress <> "" Then
            URL = URL & hyperlink.Hyperlinks(a).Address & "#" & hyperlink.Hyperlinks(a).SubAddress & vbCrLf
        Else
            URL = URL & hyperlink.Hyperlinks(a).Address & vbCrLf
        End If
    Next a

End Function

Upvotes: 2

Tim Williams
Tim Williams

Reputation: 166146

Try this:

Function URL(Hyperlink As Range) As String
  Dim sa As String
  If Hyperlink.Hyperlinks.Count = 0 Then Exit Function
  With Hyperlink.Hyperlinks(1)
    sa = .SubAddress  'anything after #
    URL = .Address & IIf(sa <> "", "#" & sa, "")
  End With
End Function

Upvotes: 2

Guillaume BEDOYA
Guillaume BEDOYA

Reputation: 265

You can try this:

URL = Hyperlink.Hyperlinks(1).TextToDisplay

Upvotes: -1

Related Questions