Bulk copy paste using VBA coding?

[Reddy]

Hi

REQUIREMENT: BULK COPY FROM ONE NORMAL EXCEL TO TM1 TEMPLATE EXCEL WHICH INTURN SHOULD SAVE IN TM1 DATABASE.

Below pasted code (from bihint site) creates a macro command bar "TM1 freeze" and deletes all tm1 formulae but can anyone help me in modifying or completing this code such that values copied from other excel to TM1 template gets uploaded into cubes and TM1 database?

Code: Select all

-----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

Your help is highly appreciated.

[John Hobson]

Hi Reddy - it's quite easy in concept to copy a single source value

You need to capture the source value an assign it to a variable then:

1. Loop through the target area cells
2, With each cell..
3. Test if it is a DBR / DBRW
4. If not then next cell and goto 3
5. Capture the formula in the cell and assign it to a variable
6. Dissect out the cell references used in the DBR using string logic
7. Put them into a VBA DBS and use that DBS to send the source value to the target cell
8. Reinstate the original DBR (which would now retrieve the copied value you just sent)
9. Next cell until the end of the range
10. End

With a bit more thought the same logic could be used to copy a source matrix to a similar sized matrix target.

Hope this helps. Do feel free to post the code if you complete it

[lotsaram]

Reddy,

In principle all that is required is to read in your copy range as an array then mimic data input on your target range. The main issues and complexity you will find with this is all the error checking for source and target ranges of the same size and shape.

Rather than go to all the additional effort have you considered the alternatives which would require no VBA coding?
- Use TM1 Web not Excel for accepting the pasted values from normal Excel
- Paste to cube viewer not Excel slices
- Paste to In Spreadsheet Browser cube views not Excel slices
- Set up your input templates with "value capture" regions for pasting external values (or direct input) with DBSW formulas in a hidden range