+ Reply to Thread
Results 1 to 2 of 2

How to make this macro run faster ?

  1. #1
    Registered User
    Join Date
    08-30-2012
    Location
    India
    MS-Off Ver
    Excel 2007
    Posts
    2

    How to make this macro run faster ?

    Hi,
    I get data from an application to excel. This data is then sent to another application (amibroker) using a macro.This happens in following steps:-
    1. From first application data is being sent to excel in realtime.
    2. Using macro now this data is then populated in a CSV file.
    3. Using macro another application (amibroker ) is called to read the CSV file.
    4. This Read - > Write -> Call amibroker , is done repetitively with a selected time interval.

    Problem is that step 2 and 3 are taking much time and some of the data although getting into excel from first application is not being picked up by the final application.

    Is there any way to make it faster ?

    Below is the code :-
    ----------------------

    Dim TimerActive As Boolean
    Public FileName As String
    Public AB As Object 'Declare AmiBroker as a public variable.
    Public ABPath As String 'Declare database path as a public variable
    Public DBPath As String 'Variable to collect User'sDatabase path
    Public NSENOW As String 'String to hold whether NOW data required
    Public MyBook As Workbook 'this holds current workbook name
    Public Vol As Variant 'Holds last volume traded today
    Public RP As Date 'Holds Refresh period in seconds



    Sub StartTimer()
    Set MyBook = Workbooks("RTNOW.xlsm")
    DBPath = MyBook.Sheets("Now").Cells(1, 2).Value
    NSENOW = MyBook.Sheets("Now").Cells(2, 2).Value
    Vol = Range("D:D").Value
    Application.Wait Now() + TimeValue("00:00:03")
    RP = Range("B3")

    If DBPath <> "" Then InitialiseAB 'Start AmiBroker
    TimerActive = True
    Timer ' Calls Timer Subroutine
    End Sub

    Public Sub Stop_Timer()
    TimerActive = False
    MsgBox ("Realtime feed stopped")
    If DBPath <> "" Then
    AB.SaveDatabase
    Set AB = Nothing 'Close the active instance of AmiBroker
    End If
    End Sub

    Private Sub Timer()
    If TimerActive = True Then
    If TimeValue(Now()) >= Range("L4").Value Then
    Debug.Print "Time is- " & Now() & " exchange closed"
    ElseIf TimeValue(Now()) <= Range("L3").Value Then
    Debug.Print "Time is- " & Now() & " exchange not open yet"
    Else
    MakeCSV 'Calls Subroutine for generating csv file
    If DBPath <> "" Then CallAmiBroker 'Calls AmiBroker for importing file
    End If

    Application.OnTime Now() + RP, "Timer" 'This code runs the Timer subroutine every 3 seconds
    End If
    End Sub


    Sub CallAmiBroker()
    Call AB.Import(0, FileName, "RTG3.format")
    Call AB.RefreshAll
    End Sub


    Sub InitialiseAB()
    On Error Resume Next
    Set AB = GetObject(, "Broker.Application")
    If AB Is Nothing Then ' True if not running
    Set AB = CreateObject("Broker.Application")
    End If
    AB.Visible = True
    ABPath = AB.DatabasePath
    If ABPath <> DBPath Then
    AB.LoadDatabase (DBPath)
    End If
    ' AB.LoadLayout ("Realtime")
    ' AB.Window.LoadTemplate ("NowRT.Chart")

    End Sub
    Sub MakeCSV()

    Dim fs As Object, a As Object, C As Integer, i As Integer, R As Integer, S As String, t As Variant, CellValue As String
    'Create a file object for writing
    Set fs = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    'MkDir ("C:\RT") 'This will create a folder RT in C Drive.
    FileName = "R:\MyCSVNOW.txt" 'This file is used to write quotes
    Set a = fs.CreateTextFile(FileName, True) 'Here we create the file MyCSV.csv
    MyBook.Sheets("Now").Select 'Selects sheet containing quotations

    If NSENOW = "Yes" Then

    For R = 7 To Range("A65536").End(xlUp).Row
    S = Format(Date, "dd/mm/yyyy") & ","
    C = 1
    While Not IsEmpty(Cells(R, C))
    If C = 2 Then
    CellValue = Format(Cells(R, C).Value, "HH:mm:ss")
    ElseIf C = 4 Then
    t = Cells(R, C).Value - (Vol(R, 1))
    Vol(R, 1) = Cells(R, C).Value
    CellValue = t
    ' Debug.Print Cells(R, 1).Value & t & " - " & Vol(R, 1)
    Else
    CellValue = Cells(R, C).Value '
    End If
    S = S & CellValue & "," 'Add contents of current cell to string 's' and a comma
    C = C + 1
    Wend
    a.writeline S 'write line to the file MyCSV.csv

    Next R
    End If
    End Sub

    --------------------

  2. #2
    Registered User
    Join Date
    08-30-2012
    Location
    India
    MS-Off Ver
    Excel 2007
    Posts
    2

    Re: How to make this macro run faster ?

    any help would be greatly appreciated ...

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1