Hyperlink Text in a Excel Row Automatically

Try this code.  Just delete the old and use this instead.  You'll need to make the same changes in it that you made in the first.  This time, if you type a name into the sheet and a file of that name already exists, then the hyperlink is still created and the file is opened.  No second new file is made.  This could result in multiple "Coffee" entries on the sheet.

Private Sub Worksheet_Change(ByVal Target As Range)

   'after typing into a single cell in column A below row 1,

   'either a workbook will be created using a template file

   'in the same folder with this file and saved using the

   'name typed into the cell, also in the same folder.

   'Once the new workbook is created and saved, then

   'the cell will be set up with a hyperlink to the created file.

   '

Const nameOfTemplateFile = "Book1.xltm" ' change as required   Const invalidFNCharacters = "<>:|/?*"""

   Const maxNameLength = 260

   Const FirstPossibleRowToUse = 2

   Dim myPath As String

   Dim newName As String

   Dim typeFile As String

   Dim hyperLink As String

   Dim LC As Integer ' loop counter

  'test if change in column A, and only 1 cell changed, and

   'the cell is not in a "protected" row (row 1 for now)

   'the result of the change is not an empty cell ( [Del] used)

   If Target.Column <> 1 Or _

    Target.Row < FirstPossibleRowToUse Or _

    Target.Cells.Count > 1 Or _

    IsEmpty(Target) Then

     Exit Sub

   End If

   'ask if the user really wants to create this new workbook

   If MsgBox("Do you wish to create a workbook named:" & _

    vbCrLf & Target.Value & " ?", vbYesNo + vbQuestion, "Continue Creating File?") _

    <> vbYes Then

     Exit Sub ' user chose not to create the file

   End If

   newName = Trim(Target.Value)

   'make sure there are no illegal characters in the entered name

   'if any illegal characters found, change to _ character

   If newName = "" Then

     MsgBox "Invalid filename - cannot continue.", _

      vbOKOnly + vbCritical, "Empty Filename"

     Exit Sub ' cannot name a book with empty string!

   End If

   For LC = 1 To Len(invalidFNCharacters)

     newName = Replace(newName, Mid(invalidFNCharacters, LC, 1), "_")

   Next

   'get path to this workbook

   myPath = ThisWorkbook.Path & Application.PathSeparator

   Application.ScreenUpdating = False

   'new workbook is now active

   newName = myPath & newName

   If Len(newName) > (maxNameLength - 5) Then

     MsgBox "The name you have chosen, combined with " & _

      "the path to the file is longer than Windows permits." & _

      vbCrLf & "Cannot Continue...", _

      vbOKOnly + vbCritical, "Complete Name Too Long"

     Exit Sub

   End If

   'prepare for last check - add file type identifier

   'based on the .FileFormat property

   Select Case ActiveWorkbook.FileFormat

     Case Is = xlWorkbookNormal, xlExcel8, xlExcel9795

       'Excel 97-2003 compatible file

     newName = newName & ".xls"

    Case Is = xlOpenXMLWorkbook

       'Excel 2007/2010 file without macros

     newName = newName & ".xlsx"

    Case Is = xlOpenXMLWorkbookMacroEnabled

       'Excel 2007/2010 file with macros

     newName = newName & ".xlsm"

  End Select

  'last check: does a file of this name already exist?

  'if it does, then go ahead and make the link and

  'open the existing file.

  'this might result in duplicate entries in this workbook

  If Dir$(newName) <> "" Then

    'make the hyperlink

    Application.EnableEvents = False

    Target.Hyperlinks.Add Anchor:=Target, Address:=newName, _

     TextToDisplay:=Target.Value

    Application.EnableEvents = True

    'just open the workbook and abort this operation

    'open the workbook, update any links, do NOT open as Read Only.

    Workbooks.Open newfilename, True, False

    Set basecell = Nothing

    Exit Sub

  End If

  'create new file from template in this same folder

  Workbooks.Add Template:=myPath & nameOfTemplateFile

  Application.DisplayAlerts = False

   'save the file based on the typeFile

   Select Case ActiveWorkbook.FileFormat

     Case Is = xlWorkbookNormal, xlExcel8, xlExcel9795

       'Excel 97-2003 compatible file

     ActiveWorkbook.SaveAs Filename:=newName, _

      FileFormat:=xlExcel8, Password:="", _

      WriteResPassword:="", ReadOnlyRecommended:=False, _

      CreateBackup:=False

    Case Is = xlOpenXMLWorkbook

       'Excel 2007/2010 file without macros

     ActiveWorkbook.SaveAs Filename:=newName, _

      FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    Case Is = xlOpenXMLWorkbookMacroEnabled

       'Excel 2007/2010 file with macros

     ActiveWorkbook.SaveAs Filename:=newName, _

      FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False

  End Select

   ActiveWorkbook.Close

   'back into this workbook

   'add the hyperlink to the cell

   Application.EnableEvents = False

   Target.Hyperlinks.Add Anchor:=Target, Address:=newName, _

    TextToDisplay:=Target.Value

   Application.EnableEvents = True

   Set basecell = Nothing

 'assume that the presence of a hyperlink to a file

 'is confirmation enough that all went well.

End Sub