Auto create a Hyperlink in VBA

Hi,

I have created a Macro to Auto Create a Hyperlink to "Place in This Document".

I have created an Index where I place the Hyperlink, the Title in the Index is the same to where I want to go with the Hyperlink.

I have a problem, as if I just set the complete Title for the Hyperlink, it does not work on long Titles as it puts a "#" in front of the link.

If I tell it to only take the first so many Characters using "LEFT(TLinkS, nn)" it works for the one I am testing it on and Titles of less than the number, but it does not work on all.

if I set the length to "Number of Characters" it works, on that title but not on others.

Title                                           Number of Characters.

Boss                                            Works on Not set or any number

Two Pints of Larger and a Packet of Crisps                       12

You, Me and Them                                                           11

Here is a selection of my list of my current Titles...

2 Broke Girl$

24 Hours

24 Hours: Live Another Day

30 Rock

A League of Their Own

Ben & Kate

Boss

The Big ‘C’

Breaking Amish: Los AngelesBreaking

Amish: Brave New World

Brooklyn Nine-Nine

Doctor Who: The 12th Doctor

Don’t Trust the B**** in Apartment 23

Fact or Faked

F/X: The Series

Marvel’s Agents of S.H.I.E.L.D.

Police Women of…

The Vampire Diaries 2: The Originals

Two Pints of Larger and a Packet of Crisps

You, Me and Them

Here is my Macro...

Sub Hyperlink()
'Setting Hyperlink
    'System Settings
    Dim styStyle As Style
    Dim DandST As String
    Dim TLinkS As String
    Dim TLinkR As Range
    Application.ScreenUpdating = False
    StatusBar = "Please Wait...  Creating Hyperlink..."

    'Selecting the Programme Title
    With Selection
        .EndKey Unit:=wdLine
        .HomeKey Unit:=wdLine, _
            Extend:=wdExtend
    End With

    'Replace Spaces with '_'
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "^w"
        .Replacement.Text = "_"
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    'Set the Hyperlink
    TLinkS = Selection.Range
    Set TLinkR = Selection.Range

    'Replace '_' with Spaces
    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "_"
        .Replacement.Text = " "
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

    'Set the Display & ScreenTip
    DandST = Selection.Range

    'Set Hyperlink
    ActiveDocument.Hyperlinks.Add _
        Anchor:=TLinkR, _
        Address:="", _
        SubAddress:="_" & Left(TLinkS, 12), _
        ScreenTip:="Goto " & DandST & "...", _
        TextToDisplay:=DandST

    'Delete Hyperlink Style if it Exist...
    StatusBar = "Please Wait...  Deleting the Hyperlink Style..."
    For Each styStyle In ActiveDocument.Styles
        If styStyle.NameLocal = "Hyperlink" Then
                If styStyle.InUse Then
                    styStyle.Delete
                Exit For
                End If
        End If
    Next

    'Start Point
    With Selection
        .HomeKey Unit:=wdStory
    End With

    'System Settings
    Application.ScreenUpdating = True
    StatusBar = ""
End Sub

I have set the place I think the problem is in BOLDITALIC.

Thank you for looking in on this for me.

Neil