In777
In777

Reputation: 181

Get formulas from closed workbook

I have an Excel file with several formulas in the first row. The formulas look like this:

=TR(Sheet1!B1;"Tr.TPESTValue;TR.TPEstValue.brokername; TR.TPEstValue.date; TR.TPEstValue.analystname;TR.TPEstValue.analystcode";"Curn=EUR SDate=20101106 EDate=20150701 CH=Fd";$B$1)

This formulas allow to connect via Add-In (xlam) to the external database in Internet and are used to retrieve the data from this database. If I have them all in one file, they are exercised at once and file crashes.

So I want to write VBA which copies formulas to other workbook and new sheet one by one, hence waits some 1 or 2 minutes until the formula in the previous sheet has retrieved the data, then copy the next one without opening an original file which I use as "database" for formulas.

My code, which does work with formulas (when Add-In is disabled), looks like this:

Sub get_formula()

Dim Sheet_i As Worksheet
Dim o As Excel.Workbook
Dim raw_i As Long

For raw_i = 1 To 524


Set o = GetObject("d:\formulas.xlsx")
Set Sheet_i = Worksheets.Add(after:=Worksheets(Worksheets.Count))
Sheet_i.Cells(1, 1).Formula = o.Worksheets("Sheet1").Cells(raw_i, 1).Formula
Set o = Nothing ' this ensures that the workbook is closed immediately


Application.Wait (Now + #00:03:00 AM#)

Next raw_i 

End Sub

However, if I log in to the database the macro does not work. I am not sure, is it because the original workbook is opened by excel at some level for small amount of time (so the retrieving of the data begins by the two workbooks) or the problem is with Application.Wait. I presume that Application.Wait not only pauses the macro but also prevent the formula to retrieve the data. Is it any way to pause the macro but not the excel sheet?

Upvotes: 2

Views: 546

Answers (1)

EEM
EEM

Reputation: 6659

Please validate\correct my understanding of the issue:

  1. All starts from a workbook with one sheet Sheet1 that contains in column B a list of ISINs

  2. The procedure get_formula is used to:

    a. Add a new worksheet for each ISN in Sheet1

    b. Enter in A1 a formula pointing to an UDF resident in an AddIn. This formula is retrieved from a separated template workbook.

  3. Before running the procedure get_formula the AddIn is deactivated

As regards this statement:

However, if I log in by the database the macro does not work. I am not sure, is it because the original workbook is opened by excel at some level for small amount of time (so the retrieving of the data begins by the two workbooks) or the problem is with Application.Wait. I presume that Application.Wait not only pauses the macro but also prevent the formula to retrieve the data. Is it any way to pause the macro but not the excel sheet?

In this respect the Application.Wait Method (Excel) says:

The Wait method suspends all Microsoft Excel activity and may prevent you from performing other operations on your computer while Wait is in effect. However, background processes such as printing and recalculation continue.

As this formula is actually an UDF, it's possible that it is not running because of the wait, however I cannot test that cause this is not just a UDF with calculation but also run s a connection to a database.

Also there is a discrepancy between the formula in the post:

=TR('Sheet 1'!C1;'Sheet 1'!$F$1:$F$5;"Frq=D SDate=#1 EDate=#2 Curn=EUR CH=Fd";$B$1;'Sheet 1'!$D$1;'Sheet 1'!$E$1)

And the formulas in the template workbook:

=TR(Sheet1!B1,"Tr.TPESTValue;TR.TPEstValue.brokername; TR.TPEstValue.date; TR.TPEstValue.analystname;TR.TPEstValue.analystcode","Curn=EUR SDate=20101106 EDate=20150701 CH=Fd",$B$1)

Op has indicated that the formula from the template workbook is the one to be used.

This solution contains the formula to be applied as a constant therefore there is not need to open the template workbook, so no need to wait.

It assumes the sheet holding the list of ISINs is named ISINs (changed if required)

It names the new sheets with the respective ISIN for easy identitfication and navigation.

It has the option to set calculation to manual before updating the workbook, setting it back to the user original settings at the end. Suggest to run it both ways to test\validate speed.

Sub ISINs_Set_Published()
'All lines starting with ":" have the purpose of measuring tasks time and printing it in the immediate window
'They should be commented or deleted after the time assessment is completed
: Dim dTmeIni As Date
: Dim dTmeLap As Date
: Dim dTmeEnd As Date

Const kISINs As String = "ISINs"
Const kFml As String = "=TR(kCll," & _
    "'Tr.TPESTValue;TR.TPEstValue.brokername; TR.TPEstValue.date; TR.TPEstValue.analystname;TR.TPEstValue.analystcode'," & _
    "'Curn=EUR SDate=20101106 EDate=20150701 CH=Fd',$B$1)"

Dim WshSrc As Worksheet, WshTrg As Worksheet
Dim rSrc As Range, rCll As Range
Dim sFml As String
Dim tCalculation As XlCalculation

: SendKeys "^g^a{DEL}": Stop
: dTmeIni = Now: dTmeLap = dTmeIni: dTmeEnd = dTmeIni
: Debug.Print vbLf; dTmeEnd, Format(dTmeEnd - dTmeLap, "hh:mm:ss"), "Process starts"

    Rem Application Settings
    'Change Excel settings to improve speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    tCalculation = Application.Calculation          'To save user setting
    Application.Calculation = xlCalculationManual   'Set calculation to manual so formulas will not get calculated till end of process

    Rem Set Range with ISINs
    With ThisWorkbook.Worksheets(kISINs).Columns(2)
        Set rSrc = .Cells(2).Resize(-1 + .Cells(.Cells.Count).End(xlUp).Row)
    End With

: dTmeEnd = Now
: Debug.Print vbLf; dTmeEnd, Format(dTmeEnd - dTmeLap, "hh:mm:ss"), , "Loop starts"
: dTmeLap = dTmeEnd

    Rem Add ISINs Worksheets
    For Each rCll In rSrc.Cells

: dTmeEnd = Now
: Debug.Print vbLf; dTmeEnd, Format(dTmeEnd - dTmeLap, "hh:mm:ss"), , , "ISIN: "; rCll.Value2
: dTmeLap = dTmeEnd

        Rem Refresh Formula
        With WorksheetFunction
            sFml = .Substitute(kFml, Chr(39), Chr(34))
            sFml = .Substitute(sFml, "kCll", Chr(39) & rCll.Worksheet.Name & Chr(39) & Chr(33) & rCll.Address)
        End With

        Rem Add Worksheet
        With ThisWorkbook
            On Error Resume Next
            .Sheets(rCll.Value2).Delete     'Deletes ISIN sheet if present
            On Error GoTo 0
            Set WshTrg = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        End With

        Rem Name Worksheet & Set Formula
        With WshTrg
            .Name = rCll.Value2

: dTmeEnd = Now
: Debug.Print dTmeEnd, Format(dTmeEnd - dTmeLap, "hh:mm:ss"), , , "Set Formula starts"
: dTmeLap = dTmeEnd

            .Cells(1).Formula = sFml

: dTmeEnd = Now
: Debug.Print dTmeEnd, Format(dTmeEnd - dTmeLap, "hh:mm:ss"), , , "Set Formula ends"
: dTmeLap = dTmeEnd

    End With: Next

: dTmeEnd = Now
: Debug.Print vbLf; dTmeEnd, Format(dTmeEnd - dTmeLap, "hh:mm:ss"), , "Loop ends"
: dTmeLap = dTmeEnd

    Rem Application Settings
    Application.Goto rSrc.Worksheet.Cells(1), 1
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.Calculation = tCalculation

: dTmeEnd = Now
: Debug.Print vbLf; dTmeEnd, Format(dTmeEnd - dTmeLap, "hh:mm:ss"), , "Application Calculate starts"
: dTmeLap = dTmeEnd

    Application.Calculate

: dTmeEnd = Now
: Debug.Print dTmeEnd, Format(dTmeEnd - dTmeLap, "hh:mm:ss"), , "Application Calculate ends"

: Debug.Print vbLf; dTmeEnd, Format(dTmeEnd - dTmeIni, "hh:mm:ss"), "Procedure ends"

End Sub

As mentioned earlier I cannot test the results of the formulas as they point to your AddIn, but if the formulas in the workbook provided are working then these should also as they are exactly same as the sample.

Upvotes: 2

Related Questions