Skip navigation.
spilling the beans

removing TM1 formulas from Excel sheets

developers
|

The following code adds a button in your Excel toolbars to replace all TM1 formulas in the current book with their values in order to get your worksheets TM1-free.

It works in a similar fashion as KillTM1 from R. Gardiner
Though it offers the added features:
.toolbar/button for ease of use
.applies to all sheets in the workbook
.changes all TM1 DB functions (DBRW, DBR, DBA...) and SUBNM/VIEW into values

This code might get included in a future version of the TM1 Open Source Toolkit

/!\ Mind that dynamic spreadsheets will regenerate all the DBRW formulas in the section boundary on a reload unless you remove all the stored names.

A quick equivalent hack is to simply drop the "paste values" icon next to the copy icon in the standard Excel toolbar. So when you need to remove formulas, click top left corner of the sheet and copy + paste values buttons. It does the job just as fast.

-----MODULE1--------------
Function bCommandBarExists(sCmdBarName As String) As Boolean
'test if a given menu exists

    Dim bCbExists As Boolean
        
    Dim cb As CommandBar

    bCbExists = False
    For Each cb In Application.CommandBars
        If cb.name = sCmdBarName Then
            bCbExists = True
            Exit For
        End If
    Next

    bCommandBarExists = bCbExists

End Function

Sub addMenu()
'add "freeze values" entry in TM1 menu

  Dim cmdbar As CommandBar
  Dim toolsMenu As CommandBarControl
  Dim myMenu As CommandBarPopup
  Dim subMenu As CommandBarControl
  
' Point to the Worksheet Menu Bar
  Set cmdbar = Application.CommandBars("Worksheet Menu Bar")

' Point to the Tools menu on the menu bar
  Set toolsMenu = cmdbar.Controls("TM1")
  
' Create the sub Menu(s)
  Set subMenu = toolsMenu.Controls.Add
  

    With subMenu
      .Caption = "Freeze values"
      .BeginGroup = True
      .OnAction = "'" & ThisWorkbook.name & "'!DeleteTM1Formulas" ' Assign Macro to Menu Item
    End With


End Sub
Sub BuildCustomToolbar()
'build a new TM1 toolbar for "freeze values"

Dim oCmdBar As CommandBar
On Error Resume Next

'point to custom toolbar
Set oCmdBar = CommandBars("TM1 Freeze")

'if it doesn't exist create it
If Err <> 0 Then
Set oCmdBar = CommandBars.Add("TM1 Freeze")
Err = 0
With oCmdBar
'now add a control
With .Controls.Add(msoControlButton)
.Caption = "Freeze Values"
.OnAction = "!DeleteTM1Formulas"
.Tag = .Caption
'set the button icon
.FaceId = 107
End With
End With
End If

'make it visible
oCmdBar.Visible = True
'on top
Application.CommandBars("TM1 Freeze").Position = msoBarTop
End Sub

Sub DeleteTM1Formulas()
'replace TM1 formulas with their current values

Dim ws As Worksheet, AWS As String, ConfirmReplace As Boolean
Dim i As Integer, OK As Boolean
    If ActiveWorkbook Is Nothing Then Exit Sub
    i = MsgBox("Replace all TM1 formulas with their current values?", _
    vbQuestion + vbYesNo)
    ConfirmReplace = False
    If i = vbNo 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
    Application.StatusBar = "Deleting external formula references in " & _
        ws.name & "..."
    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" Then
                    If Not ConfirmReplace Then
                        cl.Formula = cl.Value
                    Else
                        Application.ScreenUpdating = True
                        cl.Select
                        i = MsgBox("Replace the formula with the value?", _
                            vbQuestion + vbYesNoCancel, _
                            "Replace external formula reference in " & _
                             cl.Address(False, False, xlA1) & _
                             " with the cell value?")
                        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


Average rating
(0 votes)