+ Reply to Thread
Results 1 to 6 of 6

Creating hyperlinks in VBA

Hybrid View

  1. #1
    Registered User
    Join Date
    01-17-2008
    Posts
    21

    Creating hyperlinks in VBA

    Further to my previous thread, I now need the cells created to be hyperlinks; i.e. now, instead of "http://..." appearing, the same word as was typed (e.g. "Physics") should appear which, when clicked on, leads one to the right website. The line I added to the example I was given is repeated again below (and is also, inevitably, the only line that does not work ).

    Thanks in advance!

    Option Explicit
    
    Private Const lX_Col As Long = 5, lY_Col As Long = 7
    
    Private Sub Worksheet_Change(ByVal Target As Range)
        Select Case Target.Column
        Case lX_Col
            Dim lThisIndex As Long, varThisY As Variant, varThisX As Variant
            If Exists(Target, X_Values, lThisIndex) And Not IsEmpty(Target) Then
                varThisY = Y_Values(lThisIndex)
                varThisX = X_Values(lThisIndex)
                Me.Cells(Target.Row, lY_Col).Hyperlinks.Add Anchor:=Range(Me.Cells(Target.Row, lY_Col)), Address:=varThisY, TextToDisplay:=varThisX        
                 Else
                Me.Cells(Target.Row, lY_Col) = Empty
            End If
        End Select
    End Sub
    
    Private Function Exists _
        ( _
            ByVal element As Variant, _
            SingleRankArray As Variant, _
            Optional ByRef ZeroBasedIndex As Variant = Empty _
        ) _
    As Boolean
        Exists = False
        If IsArray(SingleRankArray) Then
            Dim lUbound As Long, lLBound As Long, lCount As Long
            Dim ThisEle As Variant
            lUbound = UBound(SingleRankArray): lLBound = LBound(SingleRankArray)
            For lCount = lLBound To lUbound
                ThisEle = SingleRankArray(lCount)
                If element = ThisEle Then
                    ZeroBasedIndex = lCount - lLBound
                    Exists = True
                    Exit Function
                End If
            Next lCount
        End If
    End Function
    
    Private Function X_Values() As Variant
        X_Values = Array("Additional Mathematics", "Biology", "Chemistry", "English Language", "English Literature", "French", "History", "Latin", "Mathematics", "Physics", "Religious Studies", "Spanish")
    End Function
    
    Private Function Y_Values()
        Y_Values = Array("http://www.ocr.org.uk/qualifications/freestandingmathsquals/additional_mathematics/documents.html#past_papers", "http://www.edexcel-international.org/quals/igcse/4325/", "http://www.edexcel-international.org/quals/igcse/4335/", "http://www.aqa.org.uk/qual/gcse/eng_b_assess.php", "http://www.aqa.org.uk/qual/gcse/eng_lit_b_assess.php", "http://www.aqa.org.uk/qual/gcse/french_a_assess.php", "http://www.ocr.org.uk/qualifications/gcse/history_b_modern_world/", "http://www.ocr.org.uk/qualifications/gcse/latin/documents.html", "http://www.edexcel-international.org/quals/igcse/4400/", "http://www.edexcel-international.org/quals/igcse/4420/", "http://www.edexcel.org.uk/quals/gcse/rs/gcse/1481/", "http://www.aqa.org.uk/qual/gcse/span_a_assess.php")
    End Function
                Me.Cells(Target.Row, lY_Col).Hyperlinks.Add Anchor:=Range(Me.Cells(Target.Row, lY_Col)), Address:=varThisY, TextToDisplay:=varThisX

  2. #2
    Valued Forum Contributor
    Join Date
    08-26-2006
    Location
    -
    MS-Off Ver
    2010
    Posts
    388
    Try
    Hyperlinks.Add Anchor:=Target, Address:=varThisY, TextToDisplay:=varThisX

  3. #3
    Registered User
    Join Date
    01-17-2008
    Posts
    21
    Thanks, that does work, but it now adds hyperlinks to the column where I'm typing (i.e. Column E); I want it to add the words and hyperlinks to the other column (Column G), even though it says "1Y_Col".

    Any ideas?

  4. #4
    Valued Forum Contributor
    Join Date
    08-26-2006
    Location
    -
    MS-Off Ver
    2010
    Posts
    388
    Column G is offset by 2 columns from column E, so it will be:
    Hyperlinks.Add Anchor:=Target.Offset(0, 2), Address:=varThisY, TextToDisplay:=varThisX

  5. #5
    Registered User
    Join Date
    03-24-2008
    Location
    Calabar, Nigeria
    MS-Off Ver
    2003, 2007
    Posts
    37
    see your original thread Here

  6. #6
    Registered User
    Join Date
    01-17-2008
    Posts
    21
    TYVM everyone

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1