Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Running macros at set times in Excel 2002 2

Status
Not open for further replies.

ADE6

Programmer
Apr 4, 2004
93
GB
Hi ,

I am aware of the Application On Time method of running a macro at a set time of day.

Excel receives realtime data around the clock from another program via DDE links,about 10 seconds after every half hour I would like to run my macro.

Example times:

("21:30:10")
("22:00:10")
("22:30:10")
("23:00:10")


I was wondering if anybody had any ideas how to efficiently complete this task.

Somebody supplied me with the VBA that will hopefully complete the task, however I really don't understand what I am doing. I have pasted the macro I want to run(DDE) at the bottom of the page

Does anybody know how to set it up?

Thanks for the help

Ade


VBA:
Code:
Sub HalfHour() 
    tme = Now() ' get current time
    currHr = Hour(tme) ' current hour
    currMin = Minute(tme) 
    currSec = Second(tme) 
     
    If currMin = 30 Or currMin = 0 Then ' if it is 00 or 30 minutes
        Call myprocess ' deal with the data
    End If 
     
    If currMin < 30 Then ' find next half hour
        nextMin = "30" 
        nextHr = CStr(currHr) 
    Else 
        nextMin = "00" 
        nextHr = CStr(currHr + 1) 
    End If 
    nextTime = nextHr & ":" & nextMin & ":10" 
     
    Application.OnTime nextTime, "HalfHour" 
End Sub

Code:
Code:
Sub myprocess() 
     ' process the data here
     End Sub

Code:
Sub DDE()
'
' DDE Macro
' Macro recorded 01/10/2006 by  ADE
'
  
'
  
    Sheets("GBP-USD").Select
    Range("BA32421:BA32467").Select
    Selection.Copy
    Range("BA32422").Select
    ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Sheets("SORTED DATA").Select
    Rows("3:3505").Select
    Selection.ClearContents
    Range("A1:F2").Select
    Sheets("SORTED DATA").Select
    Cells.Select
    Selection.ClearContents
    Sheets("PASTE LINKS").Select
    Cells.Select
    Selection.ClearContents
    Sheets("DDE DATA ").Select
    Cells.Select
    Selection.Copy
    Sheets("SORTED DATA").Select
    Range("A1:F2").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("A1:F2").Select
    Cells.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, SearchOrder _
        :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
    Range("A4:F2672").Select
    Application.CutCopyMode = False
    Selection.Sort Key1:=Range("A4"), Order1:=xlDescending, Key2:=Range("B4") _
        , Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
    Range("H4:M2666").Select
    Selection.Sort Key1:=Range("H4"), Order1:=xlDescending, Key2:=Range("I4") _
        , Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
    Range("O4:T2750").Select
    Selection.Sort Key1:=Range("O4"), Order1:=xlDescending, Key2:=Range("P4") _
        , Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
    Range("V4:AA2519").Select
    Selection.Sort Key1:=Range("V4"), Order1:=xlDescending, Key2:=Range("W4") _
        , Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
    Range("AC4:AG3023").Select
    Selection.Sort Key1:=Range("AC4"), Order1:=xlDescending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("AJ4:AN2405").Select
    Selection.Sort Key1:=Range("AJ4"), Order1:=xlDescending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("AQ4:AU2246").Select
    Selection.Sort Key1:=Range("AQ4"), Order1:=xlDescending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("AX4:BB299").Select
    Selection.Sort Key1:=Range("AX4"), Order1:=xlDescending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("BE4:BI35").Select
    Selection.Sort Key1:=Range("BE4"), Order1:=xlDescending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("BE4:BI28").Select
    Selection.Cut
    Range("BE5").Select
    ActiveSheet.Paste
    Rows("4:4").Select
    Range("AU4").Activate
    Selection.Delete Shift:=xlUp
    Cells.Select
    Selection.Copy
    Sheets("PASTE LINKS").Select
    Range("A1:F2").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
    Range("A1:F2").Select
    Sheets("SORTED DATA").Select
    Range("A1:F2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "30 MINS"
    Sheets("DDE DATA ").Select
    Range("A1:F2").Select
    Sheets("GBP-USD").Select
    Range("AY32419").Select
    ActiveCell.FormulaR1C1 = ""
    Range("AY32412").Select
    Range("AJ32422:AN32462").Select
    Selection.ClearContents
    Selection.Interior.ColorIndex = xlNone
    Range("AW32421:AX32506").Select
    Selection.ClearContents
    Selection.Interior.ColorIndex = xlNone
    Range("AT32423:AU32504").Select
    Selection.Copy
    Range("AW32423").Select
    ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Range("AT32423:AU32504").Select
    Selection.Copy
    Range("AW32423").Select
    ActiveSheet.PasteSpecial Format:=4, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Range("AW32422:AX32504").Select
    Selection.Sort Key1:=Range("AX4"), Order1:=xlDescending, Header:=xlGuess _
        , OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
    Range("AW32422:AX32462").Select
    Selection.Copy
    Range("AM32422").Select
    ActiveSheet.PasteSpecial Format:=7, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
   Range("AW32463:AX32503").Select
    Selection.Copy
    Range("AJ32422").Select
    ActiveSheet.PasteSpecial Format:=7, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Range("FG32474:FN32513").Select
    Selection.Copy
    Range("FH32474").Select
    ActiveSheet.PasteSpecial Format:=12, Link:=1, DisplayAsIcon:=False, _
        IconFileName:=False
    Range("FO32474:FO32513").Select
    Selection.ClearContents
    Range("FG32474:FG32513").Select
    Selection.ClearContents
    Range("FD32474:FD32513").Select
    Selection.Copy
    Range("FG32474").Select
    Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False
  Range("AE32422").Select
   Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = ""
    ActiveWindow.SmallScroll Down:=21    
End Sub
 



Hi,

Something like this might work for you...
Code:
Sub Main()
    Application.OnTime TimeValue("17:00:10"), "RunMyRunProcess"

End Sub
Sub RunMyRunProcess()
 'run the procees every 30 minutes, stop 8 hours from now
    RunMyProcess Now + #8:00:00 AM#, "MM", 30
End Sub
Sub RunMyProcess(dStop As Date, Optional sIntervalType As String = "MM", Optional iInterval As Integer = 30)
    Dim tTim As Date, vConvFactor
    
    'time is a number less than 1.  You can format in some time format
    'time is in units of days, so convert HOURS, MINUTES or SECONDS
    
    Select Case sIntervalType
        Case "HH"   'hours
            vConvFactor = 24         '24 hrs per day
        Case "MM"   'minutes
            vConvFactor = 24 * 60       '24 * 60 minutes per day
    End Select
    
    tTim = Now
    Do
        If (((Now - Int(Now)) * vConvFactor)) > (((tTim - Int(tTim)) * vConvFactor)) + iInterval Then
            myprocess
        End If
        If Now > dStop Then Exit Do
        DoEvents
    Loop
    
End Sub
Sub myprocess()
     ' process the data here
End Sub


Skip,
[sub]
[glasses] [red][/red]
[tongue][/sub]
 
If you will GOOGLE Chip Pearson VBA OnTime, the second hit is called topic index. Go to the topic index, look at ontime.

there is windows API timer code that I have been using for months and it works every time. All you have to do is copy the code to your project, tell it which macro to run and when. It will do the rest as long as your machine is up.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top