VBA - Duplicate Entry Created when Updating Cell Contents

Use another cell that is filled when B5 is first changed, so that you can tell if B5 had been filled before - so choose a cell that can be filled, say B4, and after this line

If Target.Address <> "$B$5" Then Exit Sub

Add this line

If Range("B4").Value = "Already Named" Then Exit Sub

and after this line:

ActiveSheet.Name = strSheetName

Add these 3 lines:

Application.EnableEvents = False
Range("B4").Value = "Already Named"
Application.EnableEvents = True

Sorry - I was confused as to what you wanted. Try this version:

Private Sub Worksheet_Change(ByVal Target As Range)
    'Check if something changed in the J column
    If Target.Column = ActiveSheet.Range("J1").Column Then UpdateCalendar

    'Specify the target cell whose entry shall be the sheet tab name.
    If Target.Address <> "$B$5" Then Exit Sub
        'If the target cell is empty (contents cleared) then do not change the sheet name
    If IsEmpty(Target) Then Exit Sub

    'If the length of the target cell's entry is greater than 31 characters, disallow the entry.
    If Len(Target.Value) > 31 Then
        MsgBox "Worksheet tab names cannot be greater than 31 characters in length." & vbCrLf & _
        "You entered " & Target.Value & ", which has " & Len(Target.Value) & " characters.", , "Keep it under 31 characters"
        Exit Sub
    End If

    'Sheet tab names cannot contain the characters /, \, [, ], *, ?, or :.
    'Verify that none of these characters are present in the cell's entry.
    Dim IllegalCharacter(1 To 10) As String, i As Integer
    IllegalCharacter(1) = "/"
    IllegalCharacter(2) = "\"
    IllegalCharacter(3) = "["
    IllegalCharacter(4) = "]"
    IllegalCharacter(5) = "*"
    IllegalCharacter(6) = "?"
    IllegalCharacter(7) = ":"
    IllegalCharacter(8) = ";"
    IllegalCharacter(9) = "'"
    IllegalCharacter(10) = """"
    For i = 1 To 10
        If InStr(Target.Value, (IllegalCharacter(i))) > 0 Then
            MsgBox "You used a character that violates sheet naming rules." & vbCrLf & vbCrLf & _
            "Please re-enter a sheet name without the ''" & IllegalCharacter(i) & "'' character.", 48, "Not a possible sheet name !!"
            Exit Sub
        End If
    Next i

    'Verify that the proposed sheet name does not already exist in the workbook.
    Dim strSheetName As String, wks As Worksheet, bln As Boolean
    strSheetName = Trim(Target.Value)
    On Error Resume Next
    Set wks = ActiveWorkbook.Worksheets(strSheetName)
    On Error Resume Next
    If Not wks Is Nothing Then
        bln = True
    Else
        bln = False
        Err.Clear
    End If

    'If the worksheet name does not already exist, name the active sheet as the target cell value.
    'Otherwise, advise the user that duplicate sheet names are not allowed.
    If bln = False Then
        ActiveSheet.Name = strSheetName
        If Range("B4").Value = "Already Named" Then Exit Sub
        Application.EnableEvents = False
        Range("B4").Value = "Already Named"
        Application.EnableEvents = True
    Else
        MsgBox "There is already a sheet named " & strSheetName & "." & vbCrLf & _
        "Please enter a unique name for this sheet."
        Exit Sub
    End If
    
    '--------------------------------------------------------------------------------------------------------------------------------------------
    
    'Set a variable to hold the business list worksheet (that way it doesn't need to be selected to work with it)
    Dim BusinessList As Worksheet: Set BusinessList = Worksheets("Business List")
    
    'Get the last row with a value in column B, goes way down to 60,000 and says
    'Go up until you find a value in a cell. Add 1 to move to the blank line
    Dim LastRecord As Integer: LastRecord = BusinessList.Range("B60000").End(xlUp).Row + 1
    
    'Select the sheet so the user can see it work its magic
    'BusinessList.Activate
    
    'If the sheet name has a space it should be encapsulated with single quotes like so
    '='The Example Name'!B5
    'If there is no space it doesn't need the single quotes
    '=TheExampleName!B5
    Dim strSheet As String: strSheet = strSheetName
    If InStr(strSheetName, " ") > 0 Then strSheet = "'" & strSheetName & "'"
    
    'Fill in the formulas
    BusinessList.Range("B" & LastRecord).Formula = "=" & strSheet & "!B5"
    BusinessList.Range("C" & LastRecord).Formula = "=" & strSheet & "!I4"
    BusinessList.Range("D" & LastRecord).Formula = "=" & strSheet & "!J4"
    BusinessList.Range("E" & LastRecord).Formula = "=" & strSheet & "!K4"
    BusinessList.Range("F" & LastRecord).Formula = "=" & strSheet & "!B3"
    BusinessList.Range("G" & LastRecord).Formula = "=" & strSheet & "!C3"
    
    'Add the hyperlink
    BusinessList.Hyperlinks.Add _
    Anchor:=BusinessList.Range("B" & LastRecord), _
    Address:="", _
    SubAddress:=strSheet & "!A1"
    
    'Scroll to the new row
'    BusinessList.Rows(LastRecord & ":" & LastRecord).Activate
End Sub

This version works fantastic for updating the sheet names and corrects the duplicate entry on the summary page, but the hyperlink breaks when the sheet name is updated.

Edited to add: In thinking more about this, it is probably because the sheet name is updating, so the original hyperlink does not have anything to refence to since the original sheet name was changed. If this is difficult to correct, we can make do with the original code additions you provided and operate understanding that any updates made to B5 will not update the sheet name. The only updates I can see occuring would be due to errors (typo, etc) on initial entry.

We can use the HyperLink function, with dynamic references to the original cell:

Private Sub Worksheet_Change(ByVal Target As Range)
    'Check if something changed in the J column
    If Target.Column = ActiveSheet.Range("J1").Column Then MsgBox " UpdateCalendar"

    'Specify the target cell whose entry shall be the sheet tab name.
    If Target.Address <> "$B$5" Then Exit Sub
        'If the target cell is empty (contents cleared) then do not change the sheet name
    If IsEmpty(Target) Then Exit Sub

    'If the length of the target cell's entry is greater than 31 characters, disallow the entry.
    If Len(Target.Value) > 31 Then
        MsgBox "Worksheet tab names cannot be greater than 31 characters in length." & vbCrLf & _
        "You entered " & Target.Value & ", which has " & Len(Target.Value) & " characters.", , "Keep it under 31 characters"
        Exit Sub
    End If

    'Sheet tab names cannot contain the characters /, \, [, ], *, ?, or :.
    'Verify that none of these characters are present in the cell's entry.
    Dim IllegalCharacter(1 To 10) As String, i As Integer
    IllegalCharacter(1) = "/"
    IllegalCharacter(2) = "\"
    IllegalCharacter(3) = "["
    IllegalCharacter(4) = "]"
    IllegalCharacter(5) = "*"
    IllegalCharacter(6) = "?"
    IllegalCharacter(7) = ":"
    IllegalCharacter(8) = ";"
    IllegalCharacter(9) = "'"
    IllegalCharacter(10) = """"
    For i = 1 To 10
        If InStr(Target.Value, (IllegalCharacter(i))) > 0 Then
            MsgBox "You used a character that violates sheet naming rules." & vbCrLf & vbCrLf & _
            "Please re-enter a sheet name without the ''" & IllegalCharacter(i) & "'' character.", 48, "Not a possible sheet name !!"
            Exit Sub
        End If
    Next i

    'Verify that the proposed sheet name does not already exist in the workbook.
    Dim strSheetName As String, wks As Worksheet, bln As Boolean
    strSheetName = Trim(Target.Value)
    On Error Resume Next
    Set wks = ActiveWorkbook.Worksheets(strSheetName)
    On Error Resume Next
    If Not wks Is Nothing Then
        bln = True
    Else
        bln = False
        Err.Clear
    End If

    'If the worksheet name does not already exist, name the active sheet as the target cell value.
    'Otherwise, advise the user that duplicate sheet names are not allowed.
    If bln = False Then
        ActiveSheet.Name = strSheetName
        If Range("B4").Value = "Already Named" Then Exit Sub
        Application.EnableEvents = False
        Range("B4").Value = "Already Named"
        Application.EnableEvents = True
    Else
        MsgBox "There is already a sheet named " & strSheetName & "." & vbCrLf & _
        "Please enter a unique name for this sheet."
        Exit Sub
    End If
    
    '--------------------------------------------------------------------------------------------------------------------------------------------
    
    'Set a variable to hold the business list worksheet (that way it doesn't need to be selected to work with it)
    Dim BusinessList As Worksheet: Set BusinessList = Worksheets("Business List")
    
    'Get the last row with a value in column B, goes way down to 60,000 and says
    'Go up until you find a value in a cell. Add 1 to move to the blank line
    Dim LastRecord As Long: LastRecord = BusinessList.Cells(BusinessList.Rows.Count, "B").End(xlUp).Row + 1
    
    'Select the sheet so the user can see it work its magic
    'BusinessList.Activate
    
    'If the sheet name has a space it should be encapsulated with single quotes like so
    '='The Example Name'!B5
    'If there is no space it doesn't need the single quotes
    '=TheExampleName!B5
    Dim strSheet As String: strSheet = strSheetName
    If InStr(strSheetName, " ") > 0 Then strSheet = "'" & strSheetName & "'"
    
    'Fill in the formulas 
    BusinessList.Range("B" & LastRecord).Formula = "=HYPERLINK(""#'"" & " & strSheet & "!B5 & ""'!B5""," & strSheet & "!B5)"
    BusinessList.Range("C" & LastRecord).Formula = "=" & strSheet & "!I4"
    BusinessList.Range("D" & LastRecord).Formula = "=" & strSheet & "!J4"
    BusinessList.Range("E" & LastRecord).Formula = "=" & strSheet & "!K4"
    BusinessList.Range("F" & LastRecord).Formula = "=" & strSheet & "!B3"
    BusinessList.Range("G" & LastRecord).Formula = "=" & strSheet & "!C3"
    
    'Scroll to the new row
'    BusinessList.Rows(LastRecord & ":" & LastRecord).Activate
End Sub