# VBA code to remove external links in Excel 365 fails due to Microsoft patch updates after years of working...



## Garland (Jul 11, 2022)

VBA code to remove external links in Excel 365 fails due to Microsoft patch updates.

Long story short:   I had code that has been working for years that suddenly breaks due to Microsoft patch update.  The VBA code I wrote copies several worksheets to a new workbook.  I have links with named ranges which were able to normally convert to hard-coded values upon breaking the link, and now doesn't break and I'm getting "$NAME?" errors everywhere.  I have tried to change security settings for macro security "Enable VBA macros (not recommended; potentially dangerous code can run)", but that fails too.

Screenshots below.

/* partial code only */

 Dim strPath As String
  Dim strFileName As String
  Dim wkb, wkbDisk As Workbook
  Dim boolAlert As Boolean
  Dim astrLinks As Variant
  Dim iCtr As Long

  Set wkb = ThisWorkbook

  Application.Calculation = xlManual

  Application.Calculate

  strPath = wkb.Sheets("Working Area").Range("WorkbookPath").Value
  strFileName = wkb.Sheets("Working Area").Range("WorkbookName").Value

  astrLinks = wkbDisk.LinkSources(Type:=xlLinkTypeExcelLinks)

*/* code fails in next portion where it's supposed to break link to */*

  If IsArray(astrLinks) Then
      For iCtr = LBound(astrLinks) To UBound(astrLinks)
          wkbDisk.BreakLink Name:=astrLinks(iCtr), _
          Type:=xlExcelLinks
      Next iCtr
  End If
*/* end of code containing VBA error */*
  Call NoNames
  astrLinks = wkbDisk.LinkSources(Type:=xlLinkTypeExcelLinks)
'Application.Calculate
   If IsArray(astrLinks) Then
     For iCtr = LBound(astrLinks) To UBound(astrLinks)
         wkbDisk.BreakLink Name:=astrLinks(iCtr), _
         Type:=xlExcelLinks
     Next iCtr
   End If

Sub NoNames()
     Dim n As Name
     On Error Resume Next
     For Each n In ActiveWorkbook.Names
          n.Delete
     Next n
     On Error GoTo 0
End Sub

In main workbook:






When moved over, the formulas with named ranges remain:


----------



## Fluff (Jul 12, 2022)

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the *method* of doing so is covered by #13 of the Forum Rules.

*Be sure to follow & read the link at the end of the rule too!*

Cross posted at: VBA code to remove external links in Excel 365 fails due to Microsoft patch updates after
If you have posted the question at more places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.


----------



## beginnerVBAexpert (Today at 7:13 PM)

I ran into the same problem and have tabled it for a long time. I finally got back into the issue today. I think you may need to tweak this code a little for the extra sheets but I think it will finally solve your problem. I hope this helps you out.

```
Sub Find_namedrange_place()
Application.Calculation = xlCalculationManual


Dim xRg As Range
Dim xCell As Range
Dim xSht As Worksheet
Dim xFoundAt As String
Dim xAddress As String
Dim xShName As String
Dim xSearchName As String

On Error GoTo LinksCleared
Set Destwb = ActiveWorkbook

    ExternalLinks = Destwb.LinkSources(Type:=xlLinkTypeExcelLinks)

    For I = 1 To UBound(ExternalLinks)
        Destwb.BreakLink ExternalLinks(I), 1
        Debug.Print (ExternalLinks(I))
    Next I

LinksCleared:

On Error Resume Next

Set NmArray = CreateObject("System.Collections.ArrayList")
Set NmArrayDel = CreateObject("System.Collections.ArrayList")

For Each nm In ActiveWorkbook.Names
  If InStr(nm, "C:\") > 1 Then
    NmArray.Add nm.Name
    NmArrayDel.Add nm
  End If
Next nm


For Each nm In ActiveWorkbook.Names
  If InStr(nm, "[") > 1 Then
    NmArray.Add nm.Name
    NmArrayDel.Add nm
  End If
Next nm




xShName = Application.ActiveSheet.Name

Set xSht = Application.Worksheets(xShName)
Set xRg = xSht.Cells.SpecialCells(xlCellTypeFormulas)

On Error GoTo 0


For Each NmdRng In NmArray
    If Not xRg Is Nothing Then
        xSearchName = NmdRng
        Set xCell = xRg.Find(What:=xSearchName, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        If Not xCell Is Nothing Then
            xAddress = xCell.Address
            If IsPresent(xCell.Formula, xSearchName) Then
                xFoundAt = xCell.Address
            End If      
            Do      
            Set xCell = xRg.FindNext(xCell)
            If Not xCell Is Nothing Then
                If xCell.Address = xAddress Then Exit Do
                    If IsPresent(xCell.Formula, xSearchName) Then
                        Range(xCell.Address).Formula = Range(xCell.Address).Value
                    End If
                Else
                    Exit Do
                End If
            Loop
        End If
        On Error Resume Next
    End If
Next NmdRng

For Each NmdRng In NmArrayDel
    NmdRng.Delete
Next


End Sub


Private Function IsPresent(sFormula As String, sName As String) As Boolean
Dim xPos1 As Long
Dim xPos2 As Long
Dim xLen As Long
Dim I As Long
xLen = Len(sFormula)
xPos2 = 1
Do
xPos1 = InStr(xPos2, sFormula, sName) - 1
If xPos1 < 1 Then Exit Do
IsPresent = IsVaildChar(sFormula, xPos1)
xPos2 = xPos1 + Len(sName) + 1
If IsPresent Then
If xPos2 <= xLen Then
IsPresent = IsVaildChar(sFormula, xPos2)
End If
End If
Loop
End Function


Private Function IsVaildChar(sFormula As String, Pos As Long) As Boolean
Dim I As Long
IsVaildChar = True
For I = 65 To 90
If UCase(Mid(sFormula, Pos, 1)) = Chr(I) Then
IsVaildChar = False
Exit For
End If
Next I
If IsVaildChar = True Then
If UCase(Mid(sFormula, Pos, 1)) = Chr(34) Then
IsVaildChar = False
End If
End If
If IsVaildChar = True Then
If UCase(Mid(sFormula, Pos, 1)) = Chr(95) Then
IsVaildChar = False
End If
End If
End Function
```


----------

