Using Application.OnTime Needs to Run Procedure ONLY ONCE

tdcolumbia

New Member
Joined
Apr 3, 2015
Messages
5
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

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,166
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

New Member
Joined
Apr 3, 2015
Messages
5
OK, here's the original code, again:

Code:
[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:


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 Auto_Open procedure that runs automatically when the excel file is opened for the first time.

Code:
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
 
Last edited:

AlphaFrog

MrExcel MVP
Joined
Sep 2, 2009
Messages
16,166
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 Auto_Open and also to EndOfDayTasks so it can reschedule itself.
 

tdcolumbia

New Member
Joined
Apr 3, 2015
Messages
5
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.:)
 

Forum statistics

Threads
1,082,167
Messages
5,363,532
Members
400,747
Latest member
monty_gl

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top