Code: Select all
'***********************************************
'macro to remove TM1 formulae
'***********************************************
Sub RemoveTM1Formulae()
'replace TM1 formulas with their current values
Dim ws As Worksheet, AWS As String, ConfirmReplace As Boolean
Dim i As Integer, x As Integer, OK As Boolean
If ActiveWorkbook Is Nothing Then Exit Sub
ConfirmReplace = False
AWS = ActiveSheet.Name
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
OK = DeleteLinksInWS(ConfirmReplace, ws)
If Not OK Then Exit For
Next ws
Set ws = Nothing
Sheets(AWS).Select
Application.ScreenUpdating = True
End Sub
Private Function DeleteLinksInWS(ConfirmReplace As Boolean, _
ws As Worksheet) As Boolean
'replace formulas with their values
Dim cl As Range, cFormula As String, i As Integer
DeleteLinksInWS = True
If ws Is Nothing Then Exit Function
If ws.Name = "About" Or ws.Name = "Send to TM1" Or ws.Name = "Assumptions" Or _
ws.Name = "Summary" Or ws.Name = "A - Not In Use" Then Exit Function
ws.Activate
For Each cl In ws.UsedRange
cFormula = cl.Formula
If Len(cFormula) > 0 Then
If Left$(cFormula, 5) = "=SUBN" Or Left$(cFormula, 3) = "=DB" Or Left$(cFormula, 5) = "=VIEW" Or _
Left$(cFormula, 8) = "=IF(SUBN" Or Left$(cFormula, 6) = "=IF(DB" Or Left$(cFormula, 8) = "=IF(VIEW" _
Or Left$(cFormula, 4) = "=(DB" Then
If Not ConfirmReplace Then
cl.Formula = cl.Value
Else
Application.ScreenUpdating = True
cl.Select
Application.ScreenUpdating = False
If i = vbCancel Then
DeleteLinksInWS = False
Exit Function
End If
If i = vbYes Then
On Error Resume Next
' in case the worksheet is protected
cl.Formula = cl.Value
On Error GoTo 0
End If
End If
End If
End If
Next cl
Set cl = Nothing
Application.StatusBar = False
End Function