Using Application.OnTime Needs to Run Procedure ONLY ONCE

[tdcolumbia]

Thanks in advance for any help provided.

Hello, I am kinda of a newbie who has learned everything I currently know about Excel VBA through Google. I have now reached a state where I don't know how to ask Google what I want. So.....


I am trying to run a Logsheet spreadsheet which calls DDE data at the top of every hour + 5 seconds then at 12:00:10 AM I copy the data to a blank file, clear the existing logsheet and start over at 1am......

Here is the procedure I am using currently:
----------------------------------------------------------------------------------


Sub CURRENT_TIME()


Workbooks("REPORTS.xlsm").Worksheets("DailyReports").Range("TEST2") = TESTCOUNTER
Workbooks("REPORTS.xlsm").Worksheets("DailyReports").Range("TEST1") = Loopcount


currenthour = Hour(Now) 'Capture current hour'


If currenthour = 23 Then 'If 11:xx pm indexs to 12:05 am for next run'
nextrun = 0 'sets next run time to be an hour of 0-12 am'
Else
nextrun = (currenthour + 1) 'after lookinga at current time indexes time by 1 hour'
End If


TimeToRun = TimeSerial(nextrun, 0, 5) 'sets the time to run procedure nextrun = hou, 0 min past the hr, 5 sec'


Application.OnTime Earliesttime:=TimeToRun, procedure:="GETWWDATA" 'calls procedure at specfic time (timetorun) to run application'


Application.OnTime Earliesttime:=TimeValue("12:00:10 AM"), procedure:="EndOfDayTasks" ' Runs End of Day Report task at 10 seconds past Midnight




End Sub
-----------------------------------------------------------------

The problem I am having is that each Application.OnTime command ends up running multiple times in the Second that I am calling them to run.

My guess is that my computer processor is so fast that it can run the command multiple times within a second.

How do I get this to only run once?

Again, thanks for any help.

 

[AlphaFrog]

Hi tdcolumbia and welcome to the forum.

Application.Ontime should call GETWWDATA only once. What's in GETWWDATA; can you post that code? Where are you initializing the next hour's Ontime event?

Also consider surrounding your code with CODE tags (see my signature block below). It makes reading your code much easier.

 

[tdcolumbia]

OK, here's the original code, again:

[COLOR=#333333]Sub CURRENT_TIME()[/COLOR]


[COLOR=#333333]Workbooks("REPORTS.xlsm").Worksheets("DailyReports").Range("TEST2") = TESTCOUNTER[/COLOR]
[COLOR=#333333]Workbooks("REPORTS.xlsm").Worksheets("DailyReports").Range("TEST1") = Loopcount[/COLOR]


[COLOR=#333333]currenthour = Hour(Now) 'Capture current hour'[/COLOR]


[COLOR=#333333]If currenthour = 23 Then 'If 11:xx pm indexs to 12:05 am for next run'[/COLOR]
[COLOR=#333333]nextrun = 0 'sets next run time to be an hour of 0-12 am'[/COLOR]
[COLOR=#333333]Else[/COLOR]
[COLOR=#333333]nextrun = (currenthour + 1) 'after lookinga at current time indexes time by 1 hour'[/COLOR]
[COLOR=#333333]End If[/COLOR]


[COLOR=#333333]TimeToRun = TimeSerial(nextrun, 0, 5) 'sets the time to run procedure nextrun = hou, 0 min past the hr, 5 sec'[/COLOR]


[COLOR=#333333]Application.OnTime Earliesttime:=TimeToRun, procedure:="GETWWDATA" 'calls procedure at specfic time (timetorun) to run application'[/COLOR]


[COLOR=#333333]Application.OnTime Earliesttime:=TimeValue("12:00:10 AM"), procedure:="EndOfDayTasks" ' Runs End of Day Report task at 10 seconds past Midnight[/COLOR]

[COLOR=#333333]End Sub
[/COLOR]

And here's the GetWWData code:

Sub GETWWDATA()


TESTCOUNTER1 = TESTCOUNTER1 + 1
        


        Workbooks("REPORTS.xlsm").Worksheets("DailyReports").Range("TEST3") = TESTCOUNTER1




'Define variables
    
    Dim Channel As Long
    Dim R As Long
    Dim Loopcounter As Integer
    
    Dim Data0 As Variant
    Dim Data1 As Variant
    Dim Data2 As Variant
    Dim Data3 As Variant
    Dim Data4 As Variant
    Dim Data5 As Variant
    Dim Data6 As Variant
    Dim Data7 As Variant
    Dim Data8 As Variant
    Dim Data9 As Variant
    Dim Data10 As Variant
    Dim Data11 As Variant
    Dim Data12 As Variant
    Dim Data13 As Variant
  


    'Open DDE Channel


    Channel = DDEInitiate("View", "Tagname")
    
    'Gather Wonderware Tags
    
    Data0 = DDERequest(Channel, "Well_9_TempF")
    Data1 = DDERequest(Channel, "well_9_GPM")
    Data2 = DDERequest(Channel, "Well_9_PSI")
    Data3 = DDERequest(Channel, "Well_9_thousand_gallon_totalize")
    Data4 = DDERequest(Channel, "Well_9_ph")
    Data5 = DDERequest(Channel, "Well_9_Turbidity")
    Data6 = DDERequest(Channel, "Well_9_Draw_Down")
    Data7 = DDERequest(Channel, "Well_12_TempF")
    Data8 = DDERequest(Channel, "well_12_GPM")
    Data9 = DDERequest(Channel, "Well_12_PSI")
    Data10 = DDERequest(Channel, "Well_12_thousand_gallon_totalize")
    Data11 = DDERequest(Channel, "Well_12_ph")
    Data12 = DDERequest(Channel, "Well_12_Turbidity")
    Data13 = DDERequest(Channel, "Well_12_Draw_Down")
    


    'Close DDE Channel
    
    DDETerminate (Channel)


    'Insert data into spreadsheet
    
        R = Hour(Now())
        
    
        If R = 0 Then
    
            'Page 1 Midnight Read


            Sheets("DailyReports").Cells(33, 2).Value = Data0
            Sheets("DailyReports").Cells(33, 3).Value = Data1
            Sheets("DailyReports").Cells(33, 4).Value = Data2
            Sheets("DailyReports").Cells(33, 5).Value = Data3
            Sheets("DailyReports").Cells(33, 6).Value = Data4
            Sheets("DailyReports").Cells(33, 8).Value = Data5
            Sheets("DailyReports").Cells(33, 9).Value = Data6
            Sheets("DailyReports").Cells(33, 10).Value = Data7
            Sheets("DailyReports").Cells(33, 11).Value = Data8
            Sheets("DailyReports").Cells(33, 12).Value = Data9
            Sheets("DailyReports").Cells(33, 13).Value = Data10
            Sheets("DailyReports").Cells(33, 14).Value = Data11
            Sheets("DailyReports").Cells(33, 16).Value = Data12
            Sheets("DailyReports").Cells(33, 17).Value = Data13
            
            
        Else
        
            'Page 1 Hourly Read


            Sheets("DailyReports").Cells(R + 9, 2).Value = Data0
            Sheets("DailyReports").Cells(R + 9, 3).Value = Data1
            Sheets("DailyReports").Cells(R + 9, 4).Value = Data2
            Sheets("DailyReports").Cells(R + 9, 5).Value = Data3
            Sheets("DailyReports").Cells(R + 9, 6).Value = Data4
            Sheets("DailyReports").Cells(R + 9, 8).Value = Data5
            Sheets("DailyReports").Cells(R + 9, 9).Value = Data6
            Sheets("DailyReports").Cells(R + 9, 10).Value = Data7
            Sheets("DailyReports").Cells(R + 9, 11).Value = Data8
            Sheets("DailyReports").Cells(R + 9, 12).Value = Data9
            Sheets("DailyReports").Cells(R + 9, 13).Value = Data10
            Sheets("DailyReports").Cells(R + 9, 14).Value = Data11
            Sheets("DailyReports").Cells(R + 9, 16).Value = Data12
            Sheets("DailyReports").Cells(R + 9, 17).Value = Data13
            
            
        End If
    
    SaveReport
    CURRENT_TIME
    
    
   
End Sub

I also have a Autpen procedure that runs automatically when the excel file is opened for the first time.

Sub Auto_open() 'Will run this subroutine when the excel application opens'


Call CURRENT_TIME   'Runs subroutine to get time to run app'


Loopcount = 0
TESTCOUNTER = 0
TESTCOUNTER1 = 0








End Sub

 

[AlphaFrog]

Is it just the EndOfDayTasks macro that runs multiple times? If yes, your code sets a new ontime event every hour for the EndOfDayTasks

Application.OnTime Earliesttime:=TimeValue("12:00:10 AM"), procedure:="EndOfDayTasks"

Then at 12:00:10 AM, multiple EndOfDayTasks will run for each instance it was scheduled.

I suspect you want to remove that line from CURRENT_TIME and add it to Autpen and also to EndOfDayTasks so it can reschedule itself.

 

[tdcolumbia]

That did it!!!

I've been programming different languages for different purposes my whole adult life and it never ceases to amaze me how a simple misplaced command line can throw off everything. Nevermind the the syntax was correct!!!

thanks again, AlphaFrog.

 

[AlphaFrog]

You're welcome. Thanks for the feedback.