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