Combining two macros

[ADE6]

Hi

I have two macros that i would like to combine by adding Sub Every5() to the start of Sub AUTOINTRADAY()so that it runs every five minutes based on the conditions set out below(running 20 seconds after each five minute period.)

Must be doing something wrong as i can't get it to work.


Further down the line i will be hooking Excel up to a real time data feed for financial data.I would need to run a macro at five minute intervals.

However i can't run it exactly on the 5 minute intervals eg:-18:55:00,19:00:00,19:05:00,becuse i need to run it maybe 20 seconds after the five minute intervals to allow the data to be posted in the data feeds database,eg:-18:55:20,19:00:20,19:05:20

Sub Every5()
'start the timer on a multiple of 5 minutes
ts = #1:00:00 PM#
dur = 5 * 60 'seconds 5 minutes
seq = 1
Do
DoEvents
this = (Timer - ts - 20) Mod dur
If this < last Then
MsgBox "FIRE"
End If
last = this
Loop
End Sub


Sub AUTOINTRADAY()
'
' AUTOINTRADAY Macro
' Macro recorded 27/05/2004 by ADE
'

'
Sheets("IMPORT").Select
Range("A1:F551").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlDescending, Key2:=Range("B1") _
, Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Sheets("IMPORT").Select
Range("A2:F459").Select
ActiveWindow.SmallScroll Down:=-108
Selection.Copy
Range("B3:F730").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("FILTER").Select
ActiveWindow.SmallScroll ToRight:=-1
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G5").Select
Sheets("FILTER").Select
Range("A2:E383").ADVANCEDFILTER Action:=xlFilterCopy, CriteriaRange:=Range( _
"Z2:AE3"), CopyToRange:=Range("Z4"), Unique:=False
ActiveWindow.SmallScroll ToRight:=14
Range("A2:E383").ADVANCEDFILTER Action:=xlFilterCopy, CriteriaRange:=Range( _
"AF2:AK3"), CopyToRange:=Range("AF4"), Unique:=False
ActiveWindow.SmallScroll ToRight:=18
Range("A2:E383").ADVANCEDFILTER Action:=xlFilterCopy, CriteriaRange:=Range( _
"AL2:AQ3"), CopyToRange:=Range("AL4"), Unique:=False
ActiveWindow.SmallScroll ToRight:=-8
ActiveWindow.SmallScroll Down:=-6
Range("A3:E239").Select
Selection.Copy
Sheets("GBP INTRA").Select
ActiveWindow.SmallScroll Down:=-9
Range("A3").Select
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
Range("G36").Select
Sheets("FILTER").Select

If [B2] > [C5] And [B3] < [C7] Or _
[B2] < [C5] And [B3] > [C7] Then
xcount = 1
For xcount = 1 To 5
Beep
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 1
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
Next



End If


End Sub


Thanks for any ideas

Ade

 

[SkipVought]

Hi,

Is this what you want?

Sub Every5()
'start the timer on a multiple of 5 minutes
   ts = #1:00:00 PM#
   dur = 5 * 60  'seconds in 5 minutes
   seq = 1
   Do
      DoEvents
      this = (Timer - ts - 20) Mod dur
      If this < last Then
         AUTOINTRADAY
         seq = seq + 1
      End If
      if seq > 100 then exit do 'change this value to stop the process
      last = this
   Loop
End Sub

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884