Importing data seems to interfere with auto-scheduled macro

[Priyanka]

Hi
I have an excel workbook with a single worksheet called 'Monitor' .
This contains data which is automatically refreshed about every two
minutes. Now I have written a macro which does the following-

1. Adds a new sheet called Sheet2
2. Copies data from 'Monitor' every fifteen minutes
3. Saves the workbook after copying

In this way, I create a 'history' of the data refreshed (albeit with
wider intervals). This is stock market data by the way.

Now the problem is this. When i run the macro on a static worksheet,
it runs perfectly. Every fifteen minutes. But when i run it on a
worksheet that has the 'Import Data' option enabled, or is a Bloomberg
worksheet (I dunno what they use to refresh data on Bloomberg) , the
scheduling goes haywire. Sometimes it copies data every ten seconds,
sometimes every half an hour.

It almost seems that the Import Data command in excel is somehow
interfering with the scheduling of the macro. I just can't figure out
how. Here is the macro. Please help!

Thanks a million in advance.
Priyanka
-----------------------------------------------------------------------------------------------------------------------------------------------------------------

Public RunWhen As Double
Public Const cRunIntervalSeconds = 900 ' FIFTEEN minutes
Public Const cRunWhat = "CopyDataMacro" ' the name of the procedure
to run

Dim Sht1RowCount, Sht1ColCount As Long


Public Sub Adder()
Worksheets.Add.Name() = "Sheet2"
'Calculate size of input
Sheets("Monitor").Select
Sht1RowCount = ActiveSheet.UsedRange.Rows.Count
Sht1ColCount = ActiveSheet.UsedRange.Columns.Count


Range(Cells(5, 1), Cells(5, Sht1ColCount)).Select
Range(Cells(5, 1), Cells(5, Sht1ColCount)).Copy


'Initiate Sheet2

'Copy header row from Monitor to initiate
Sheets("Sheet2").Select
Range(Cells(1, 1), Cells(1, Sht1ColCount)).Select
ActiveSheet.Paste


CopyDataMacro()
End Sub

Sub StartTimer()
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat,
Schedule:=True
End Sub
Sub CopyDataMacro()


'Select data rows from Monitor sheet
Sheets("Monitor").Select
Range(Cells(6, 1), Cells(Sht1RowCount, Sht1ColCount)).Select
Range(Cells(6, 1), Cells(Sht1RowCount, Sht1ColCount)).Copy

'Determine input in Sheet2 sheet
Sheets("Sheet2").Select
Dim LastRow, LastColumn As Long

If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If

If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Columns.
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column

End If


'Paste in Sheet2 Range(Cells(LastRow + 1, 1), Cells(LastRow +
Sht1RowCount - 1, Sht1ColCount)).Select
Selection.PasteSpecial Paste:=xlValues
Cells(LastRow + 1, 1) = Time

 

[Priyanka]

Sorry-part of the code got truncated suring copy paste-here is the
full macro

Public RunWhen As Double
Public Const cRunIntervalSeconds = 900 ' two minutes
Public Const cRunWhat = "CopyDataMacro" ' the name of the procedure
to run


Dim Sht1RowCount, Sht1ColCount As Long


Public Sub Adder()
Worksheets.Add.Name() = "Sheet2"
'Calculate size of input
Sheets("Monitor").Select
Sht1RowCount = ActiveSheet.UsedRange.Rows.Count
Sht1ColCount = ActiveSheet.UsedRange.Columns.Count


Range(Cells(5, 1), Cells(5, Sht1ColCount)).Select
Range(Cells(5, 1), Cells(5, Sht1ColCount)).Copy


'Initiate Sheet2


'Copy header row from Monitor to initiate
Sheets("Sheet2").Select
Range(Cells(1, 1), Cells(1, Sht1ColCount)).Select
ActiveSheet.Paste
CopyDataMacro
End Sub


Sub StartTimer()
RunWhen = Now + TimeSerial(0, 0, cRunIntervalSeconds)
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat,
Schedule:=True
End Sub
Sub CopyDataMacro()


'Select data rows from Monitor sheet
Sheets("Monitor").Select
Range(Cells(6, 1), Cells(Sht1RowCount, Sht1ColCount)).Select
Range(Cells(6, 1), Cells(Sht1RowCount, Sht1ColCount)).Copy


'Determine input in Sheet2 sheet
Sheets("Sheet2").Select
Dim LastRow, LastColumn As Long


If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If


If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Columns.
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column


End If


'Paste in Sheet2 Sheet
Range(Cells(LastRow + 1, 1), Cells(LastRow + Sht1RowCount - 1,
Sht1ColCount)).Select
Selection.PasteSpecial Paste:=xlValues
Cells(LastRow + 1, 1) = Time


'Save data
If ActiveWorkbook.Saved = False Then
ActiveWorkbook.Save
End If


' Call StartTimer to schedule the procedure
StartTimer


End Sub


Sub StopTimer()
On Error Resume Next
Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat,
Schedule:=False
End Sub