Log of External Links in the workbook

Hi,

Hope all is well. I have been trying to edit a macro to list out all the external links within the workbook in the tab name "ExternalLinks". The macro lists out Sheet Reference and the cell where the external link is located. But I'm keep on stumbling upon a Run-time error '1004': Application-defined or object-defined error on line If InStr(c.Formula, UserChoice) for the following code.

The macro works if I change c.formula to c.value but that is not the result I'm looking for. Also, it will be an addition if the macro can list out the workbook & the tab named in external link in a separate columns.

Below is the code:

Sub FindExternalLinks()
    Dim X As Long, S As Worksheet, r As Range, A As Range, c As Range
    Dim External As Integer, UserChoice As String
    Dim nmName As Name, strRef As String
    
    Let X = 1
      
    On Error Resume Next

    Application.DisplayAlerts = False
    Worksheets("ExternalLinks").Delete
    Application.DisplayAlerts = True
    External = MsgBox(Prompt:="List external links only?", _
                            Title:="External or Ext & Internal", _
                            Buttons:=vbYesNoCancel)

    Select Case External
        Case vbCancel
            Exit Sub
        Case vbYes
'           UserChoice = "\["
            UserChoice = ".xls"   ' Not all external links contain "\["
        Case Else
            UserChoice = "!"
    End Select

    On Error GoTo 0

    Worksheets.Add Before:=Sheets(1)
    ActiveSheet.Name = "ExternalLinks"
    Cells(1, 1).Formula = "Sheet Ref"
    Cells(1, 2).Formula = "Cell Ref"
    Cells(1, 3).Formula = "Formula"
    Cells(1, 5).Formula = "ExternalFileName"
    Cells(1, 6).Formula = "TabName"

    With Range("1:1")
        .Font.Bold = True
        .Font.ColorIndex = 5
        .Font.Size = 14
        .Font.Underline = True
    End With

    Range("A2").Select
    ActiveWindow.FreezePanes = True
    Application.ScreenUpdating = False

    For Each S In ActiveWorkbook.Worksheets
        Set r = Nothing
        On Error Resume Next
        Set r = S.UsedRange.SpecialCells(xlFormulas)
        On Error GoTo 0
        If Not r Is Nothing Then
        For Each A In r.Areas

            For Each c In A.Cells
                If InStr(c.Formula, UserChoice) Then
                X = X + 1
                Worksheets("Formulas").Cells(X, 1) = S.Name
                Worksheets("Formulas").Cells(X, 2) = c.Address(RowAbsolute:=False, ColumnAbsolute:=False)
                Worksheets("Formulas").Cells(X, 3) = "'" & c.Formula
                End If
            Next c

            
        Next A
        End If
    Next S
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

Any help is much appreciated.