Dim aStartTime
Dim aLinks As Variant
Dim wb2 As Workbook
Sub Test()
Set wb2 = ActiveWorkbook
Call BreakAll(wb2)
End
Sub BreakAll(ByRef wb2 As Workbook)
'Dim wb2 As Workbook
'~~> Start Timer
aStartTime = Now()
'~~> Speeding Up VBA Code
'Call SpeedUp(False)
'Set wb2 = ActiveWorkbook
Call breakWorkbookLinks(wb2)
Call breakDataValidation(wb2)
'Call breakDataConnections(wb2)
Call breakConditionalFormatting(wb2)
Call breakNamedRanges(wb2)
Call breakPivotTable(wb2)
'wb2.Save
'~~> Speeding Up VBA Code
'Call SpeedUp(True)
'MsgBox "done"
End Sub
Sub breakWorkbookLinks(wb2 As Workbook)
Dim i As Long
'do as long as alinks = 0
aLinks = wb2.LinkSources(xlExcelLinks)
Application.StatusBar = "Break workbook links."
If Not IsEmpty(aLinks) Then
For i = 1 To UBound(aLinks)
Workbooks(wb2.Name).BreakLink Name:=aLinks(i), Type:=xlExcelLinks
Next i
End If
Application.StatusBar = ""
End Sub
Sub breakDataValidation(wb2 As Workbook)
Dim ws As Worksheet
Dim sDvForm As String
Dim rCell As Range
Dim Count As Double
Count = 0
wb2.Activate
For Each ws In wb2.Worksheets
Application.StatusBar = "Break data validation links. Current worksheet: " & ws.Name
For Each rCell In ws.UsedRange.Cells
'Store the Formula1 property if there is one
On Error Resume Next
sDvForm = ""
sDvForm = rCell.Validation.Formula1
On Error GoTo 0
'If Formula1 has a bracket, it's a good candidate
'for containing an external link
If InStr(1, sDvForm, "]") > 0 Then
rCell.Validation.Delete
Count = Count + 1
Application.StatusBar = CStr(Count)
End If
Next rCell
Next ws
Application.StatusBar = ""
End Sub
Sub breakDataConnections(wb2 As Workbook)
Dim i As Long
For i = 1 To wb2.Connections.Count
If wb2.Connections.Count = 0 Then Exit Sub
On Error Resume Next
wb2.Connections.Item(i).Delete
On Error GoTo 0
i = i - 1
Next i
Application.StatusBar = ""
End Sub
Sub breakConditionalFormatting(wb2 As Workbook)
Dim ws As Worksheet
Dim sDvForm As String
Dim rCell As Range
Dim i As Long
wb2.Activate
For Each ws In wb2.Worksheets
Application.StatusBar = "Break conditional formatting links. Current worksheet: " & ws.Name
For Each rCell In ws.UsedRange.Cells
'Store the Formula1 property if there is one
On Error Resume Next
For i = 1 To rCell.FormatConditions.Count
sDvForm = ""
sDvForm = rCell.FormatConditions(1).Formula1
On Error GoTo 0
'If Formula1 has a bracket, it's a good candidate
'for containing an external link
If sDvForm <> "" Then
'MsgBox sDvForm
End If
If InStr(1, sDvForm, "]") > 0 Then
rCell.FormatConditions(i).Delete
End If
Next
Next rCell
Next ws
Application.StatusBar = ""
End Sub
Sub breakNamedRanges(wb2 As Workbook)
Dim n As Name
wb2.Activate
For Each n In wb2.Names
If InStr(1, n.RefersTo, "]") > 0 Then
'MsgBox "Named Range " & n.RefersTo
n.Delete
End If
Next n
Application.StatusBar = ""
End Sub
Sub breakPivotTable(wb2 As Workbook)
'Pivot Tables
Dim pt As PivotTable
Dim ws As Worksheet
wb2.Activate
For Each ws In wb2.Worksheets
Application.StatusBar = "Break Pivot Table data links. Current worksheet: " & ws.Name
ws.Activate
For Each pt In ws.PivotTables
On Error Resume Next
If InStr(1, pt.SourceData, "]") > 0 Then
pt.TableRange2.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
On Error GoTo 0
Next pt
Next ws
Application.StatusBar = ""
End Sub
