Slicing out views to Excel

Ideas and tips for enhancing your TM1 application
Post Reply
Wim Gielis
MVP
Posts: 1529
Joined: Mon Dec 29, 2008 6:26 pm
OLAP Product: TM1
Version: PAL 2.0
Excel Version: 2016
Location: Brussels, Belgium
Contact:

Slicing out views to Excel

Post by Wim Gielis » Thu Dec 17, 2015 8:38 am

I wrote some code to bring TM1 cube views to Excel in an automated way. Check out the article on my website for details.

The code is here:

Code: Select all

Sub SliceOutViewsToExcel_InBatch()

    Dim sq As Variant
    Dim m As Long, n As Long
    Dim ErrNum As Long
    Dim sServer As String
    Dim bCreateSnapshot As Boolean
    Dim bDeleteEmptySheets As Boolean

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    'user input
    sServer = [inp_TM1Server]
    bCreateSnapshot = ([inp_Snapshot] = "Yes")
    bDeleteEmptySheets = ([inp_DeleteEmptySheets] = "Yes")
    
    sq = ActiveSheet.ListObjects("tbl_Views").DataBodyRange.Value
    
    With Workbooks.Add
    
        'create sheets and slice the data
        For m = UBound(sq) To 1 Step -1
            With .Sheets.Add
                
                'naming sheets
                On Error Resume Next
                .Name = CleanWorksheetName(Format(m, "000") & "_" & sq(m, 2) & "_" & sq(m, 1))
                If Err.Number > 0 Then
                    ErrNum = ErrNum + 1
                    .Name = "Error_" & Format(m, "000") & "_" & Format(ErrNum, "000")
                    Err.Clear
                End If
                On Error GoTo 0
                
                'main function in this macro
                Run "VUSLICE", sServer & ":" & sq(m, 1), sq(m, 2)
                
                Application.ScreenUpdating = False
                Application.DisplayAlerts = False
        
                'snapshot
                If bCreateSnapshot Then .UsedRange.Value = .UsedRange.Value
                
                'delete empty sheets
                If bDeleteEmptySheets Then
                    If .UsedRange.Cells.Count = 1 Then
                        .Delete
                    End If
                End If
                
            End With
        Next
        
        Application.ScreenUpdating = False
        Application.DisplayAlerts = False
                
        .Sheets.Add.Cells(1).Value = "Output in the next sheets"
                
        'SheetsInNewWorkbook should always be 1 in Excel, but for those who don't, I delete useless sheets
        For m = 1 To Application.SheetsInNewWorkbook
            .Sheets(.Sheets.Count).Delete
        Next

    End With
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox "Ready", vbInformation, Application.UserName

End Sub

Function CleanWorksheetName(ByVal strName As String) As String

'Adapted (improved) from:
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=1132

    Dim varBadChars As Variant
    Dim varReplacementChars As Variant

    varBadChars = Array(":", "/", "\", "?", "*", "[", "]")
    varReplacementChars = Array("", "-", "-", "", "", "(", ")")

    'correct string for forbidden characters
    For m = 0 To UBound(varBadChars)
        strName = Replace(strName, varBadChars(m), varReplacementChars(m))
    Next

    'correct string for worksheet length requirement
    CleanWorksheetName = Left(strName, 31)
    
End Function
Best regards,

Wim Gielis

Excel Most Valuable Professional, 2011-2014
http://www.wimgielis.com ==> 103 TM1 articles and a lot of custom code
Newest blog article: TM1 message log analysis with Power Query

Post Reply