There always seems to be a bit of debate about TM1 and text. TM1 is built for number crunching rather than being a text database but companies often need to store variance or budget commentry in their TM1 database. A TM1 cell can hold 255 characters but editing of that text in Excel can prove frustrating to users as they will need to re-type everything.
To make this easier for users I put together this simple vba form with the code below. Basically if the users clicks on a Light Green coloured cell, a vba form as per above will show. They can then edit existing text or enter new text and upon pressing OK the vba will DB send the text to TM1. I tried to make the code as generic as possible so it will decipher any TM1 formula. At the moment though every reference in the formula will need to be a range rather than a hard coded element name
e.g. $A$1 rather than "Jan".
The code in blue goes as an event to the worksheet. The code in red goes behind the form.
It should be pretty easy to replicate the form or I can email an example through.
Apologies that I can't figure out how to indent my code easily in html.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Interior.ColorIndex = 35 Then
Load inputWindow
inputWindow.Show
End If
End Sub
Option Explicit
'********************************************************************************
'** J.WAKEFIELD
'** Counter of characters
'********************************************************************************
Sub CountDown(ByVal inCounter As Integer)
' make sure comment is not more then 256 characters long
Dim intCounter As Integer
Application.DisplayStatusBar = True
Application.StatusBar = (255 - inCounter) & " Characters Remaining"
Me.lblCharacters.Caption = (255 - inCounter) & " Characters Remaining"
End Sub
'********************************************************************************
'** J.WAKEFIELD
'** Cancel button
'********************************************************************************
Private Sub btnCancel_Click()
'close window with out sending information
inputWindow.Hide
Unload inputWindow
Application.StatusBar = ""
End Sub
'********************************************************************************
'** J.WAKEFIELD
'** Clear text
'********************************************************************************
Private Sub btnClear_Click()
txtComments.Value = ""
End Sub
'********************************************************************************
'** J.WAKEFIELD
'** Create variables to use to send
'********************************************************************************
Private Sub btnOK_Click()
Dim arrFormula() As String, arrDims() As String
Dim strFormula As String, strCube As String
Dim iCommaPos As Integer, iBracketPos As Integer, iNoDims As Integer
Dim i As Integer
'Find Cube name
strFormula = ActiveCell.Formula
iBracketPos = InStr(strFormula, "(")
iCommaPos = InStr(strFormula, ",")
'Get cube name
strCube = ActiveSheet.Range(Mid(strFormula, iBracketPos + 1, iCommaPos - iBracketPos - 1)).Value
'Split formula by commas
arrFormula = Split(strFormula, ",", -1, vbTextCompare)
ReDim arrDims(UBound(arrFormula()))
' Get range values
For i = 1 To UBound(arrFormula())
If i = UBound(arrFormula()) Then
arrFormula(i) = Left(arrFormula(i), Len(arrFormula(i)) - 1)
End If
arrDims(i) = ActiveSheet.Range(arrFormula(i)).Value
Next i
'Pass array to be evaluated and sent
Call SendComment(strCube, arrDims())
'Clean up
Application.StatusBar = ""
Unload inputWindow
ActiveCell.Calculate
End Sub
'********************************************************************************
'** J.WAKEFIELD
'** TM1 Send comment
'********************************************************************************
Private Sub SendComment(p_strCube As String, p_Formula() As String)
Dim temp As Variant
Dim iMax As Integer
'Find number of dimensions to use correct send formula
iMax = UBound(p_Formula())
Select Case iMax
Case 3
temp = Application.Run("DBSS", txtComments.Value, p_strCube, p_Formula(1), p_Formula(2), p_Formula(3))
Case 4
temp = Application.Run("DBSS", txtComments.Value, p_strCube, p_Formula(1), p_Formula(2), p_Formula(3), p_Formula(4))
Case 5
temp = Application.Run("DBSS", txtComments.Value, p_strCube, p_Formula(1), p_Formula(2), p_Formula(3), p_Formula(4), p_Formula(5))
Case 6
temp = Application.Run("DBSS", txtComments.Value, p_strCube, p_Formula(1), p_Formula(2), p_Formula(3), p_Formula(4), p_Formula(5), p_Formula(6))
Case 7
temp = Application.Run("DBSS", txtComments.Value, p_strCube, p_Formula(1), p_Formula(2), p_Formula(3), p_Formula(4), p_Formula(5), p_Formula(6), p_Formula(7))
Case 8
temp = Application.Run("DBSS", txtComments.Value, p_strCube, p_Formula(1), p_Formula(2), p_Formula(3), p_Formula(4), p_Formula(5), p_Formula(6), p_Formula(7), p_Formula(8))
Case 9
temp = Application.Run("DBSS", txtComments.Value, p_strCube, p_Formula(1), p_Formula(2), p_Formula(3), p_Formula(4), p_Formula(5), p_Formula(6), p_Formula(7), p_Formula(8), p_Formula(9))
Case 10
temp = Application.Run("DBSS", txtComments.Value, p_strCube, p_Formula(1), p_Formula(2), p_Formula(3), p_Formula(4), p_Formula(5), p_Formula(6), p_Formula(7), p_Formula(8), p_Formula(9), p_Formula(10))
Case 11
temp = Application.Run("DBSS", txtComments.Value, p_strCube, p_Formula(1), p_Formula(2), p_Formula(3), p_Formula(4), p_Formula(5), p_Formula(6), p_Formula(7), p_Formula(8), p_Formula(9), p_Formula(10), p_Formula(11))
Case 12
temp = Application.Run("DBSS", txtComments.Value, p_strCube, p_Formula(1), p_Formula(2), p_Formula(3), p_Formula(4), p_Formula(5), p_Formula(6), p_Formula(7), p_Formula(8), p_Formula(9), p_Formula(10), p_Formula(11), p_Formula(12))
Case 13
temp = Application.Run("DBSS", txtComments.Value, p_strCube, p_Formula(1), p_Formula(2), p_Formula(3), p_Formula(4), p_Formula(5), p_Formula(6), p_Formula(7), p_Formula(8), p_Formula(9), p_Formula(10), p_Formula(11), p_Formula(12), p_Formula(13))
Case 14
temp = Application.Run("DBSS", txtComments.Value, p_strCube, p_Formula(1), p_Formula(2), p_Formula(3), p_Formula(4), p_Formula(5), p_Formula(6), p_Formula(7), p_Formula(8), p_Formula(9), p_Formula(10), p_Formula(11), p_Formula(12), p_Formula(13), p_Formula(14))
Case 15
temp = Application.Run("DBSS", txtComments.Value, p_strCube, p_Formula(1), p_Formula(2), p_Formula(3), p_Formula(4), p_Formula(5), p_Formula(6), p_Formula(7), p_Formula(8), p_Formula(9), p_Formula(10), p_Formula(11), p_Formula(12), p_Formula(13), p_Formula(14), p_Formula(15))
Case 16
temp = Application.Run("DBSS", txtComments.Value, p_strCube, p_Formula(1), p_Formula(2), p_Formula(3), p_Formula(4), p_Formula(5), p_Formula(6), p_Formula(7), p_Formula(8), p_Formula(9), p_Formula(10), p_Formula(11), p_Formula(12), p_Formula(13), p_Formula(14), p_Formula(15), p_Formula(16))
End Select
'Catch Errors
If temp = "KEY_ERR*" Then
MsgBox "An error occurred sending comment, please contact your TM1 administrator", vbCritical, "TM1"
End If
End Sub
'********************************************************************************
'** J.WAKEFIELD
'** Keep track of count
'********************************************************************************
Private Sub txtComments_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
CountDown Len(txtComments.Value)
End Sub
'********************************************************************************
'** J.WAKEFIELD
'** Display original comment
'********************************************************************************
Private Sub UserForm_Activate()
txtComments.Value = ActiveCell.Value
CountDown Len(txtComments.Value)
End Sub
