CODEWITHSUNDEEP
excelvba
Paresh Eawal
Paresh Eawal

Reputation: 11

Run macro every 15 mins

I need to refresh the "Data" Sheet every 15 mins. After refreshing the sheet I need to copy the data from D10, J10 & paste in "Chart Sheet". But while pasting first it should start from B2 & then next time data should paste below B2 i.e C2 so on & so forth.

Below is the code

Option Explicit

Sub Refresh()
    Sheets("Data").Select
    
    ActiveWorkbook.RefreshAll        
    Sheets("Collection").Select
    
    Range("D10,J10").Select
    Selection.Copy
    
    Sheets("Chart").Select
    
    'But while pasting first it should start from B2 & then
    'next time data should paste below B2 i.e C2 so on & so forth
    Range("B2").Select
    
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    
    Application.OnTime TimeValue("09.00.00"), "Refresh"
End Sub

Upvotes: 1

Views: 1569

Answers (2)

Andreas
Andreas

Reputation: 23958

Siddhart is on the correct path with his application.ontime. However there is a few things he is missing in the answer.
First of all. It's very important to keep the timevalue in a variable and disable it when the code runs.
If you don't do this the code may start several instances of the ontime and all of the sudden you have a workbook running the code all the time.

And I would add a code in the workbook open to automatically start the code.

In module:

Public firetime as date

Sub Refresh()

    Dim LR As Long
    
    ' dont run code in times outside of scope
    If Time() >= "09:00" And Time() <= "17:00" Then
        'Make sure the code does not start multiple application.ontime by removing the previous
        On Error Resume Next
        Application.OnTime EarliestTime:=fireTime, Procedure:="'Refresh", Schedule:=False
        On Error GoTo 0
    
        ActiveWorkbook.RefreshAll
        Sheets("Collection").Range("D10,J10").Copy
        LR = Sheets("Chart").Cells(Sheets("Chart").Rows.Count, "B").End(xlUp).Row + 1
        Sheets("Chart").Range("B" & LR).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        
        
        
        If Time() <= "16:45" Then
            ' between 09:00 and 16:45, run the code every 15 minutes
            fireTime = Now + TimeValue("00:15:00")
            Application.OnTime EarliestTime:=fireTime, Procedure:="Refresh", Schedule:=True
        ElseIf Time() >= "16:46" Then
            ' Pause code until tomorrow at 09:00
            fireTime = Date + 1 & " 09:00:00"
            Application.OnTime EarliestTime:=fireTime, Procedure:="Refresh", Schedule:=True
        End If
    ElseIf Time() <= "17:00" Then
        ' if it's past 17:00 the file is opened then delay the run to tomorrow.
        fireTime = Date + 1 & " 09:00:00"
        Application.OnTime EarliestTime:=fireTime, Procedure:="Refresh", Schedule:=True
        
    Else
        ' if it's before 09:00 set a schedule to run at 9:00
        fireTime = Date & " 09:00:00"
        Application.OnTime EarliestTime:=fireTime, Procedure:="Refresh", Schedule:=True
    End If
End Sub

In ThisWorkbook:

Private Sub Workbook_Open()
    
    Application.Run "Module1.Refresh" ' if the code is in Module1
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' if you close the workbook then cancel the updates.
    On Error Resume Next
    Application.OnTime EarliestTime:=fireTime, Procedure:="Refresh", Schedule:=False
    On Error GoTo 0
End Sub

If you don't have the beforeclose code then the workbook will open every 15 minutes and run.

And there is one annoying thing with Excel that you will encounter.
If the yellow border at the top says Protected mode or do you wish to enable macros IN ANY WORKBOOK then application.ontime will crash.
The only way to get around it is to run this workbook on a different computer.

Upvotes: 2

Siddharth Rout
Siddharth Rout

Reputation: 149277

There are two ways you can tackle this. In fact this answer will cover both and in detail so please be patient with me. I am going to go at lengths with this answer as I am sure this will definitely help future visitors.

WAY 01: VB Script + Windows Task Scheduler

SETTING UP VB Script

  1. Open Notepad
  2. Paste this code

Code:

Dim ExcelApp, ExcelWB
Set ExcelApp = CreateObject("Excel.Application")

'~~> Change this to the relevant Excel File
Set ExcelWB = ExcelApp.Workbooks.Open("C:\Users\routs\Desktop\Sample.xlsm")

ExcelApp.Run "Refresh"

ExcelWB.Close True

ExcelApp.Quit
Set ExcelApp = Nothing
  1. Save the file as MyTask.Vbs

enter image description here

SETTING UP TASK SCHEDULER (Win 10)

Start the Task Scheduler in Windows. If you do not know how, then type Task Scheduler in Windows search.

enter image description here

Click on Create Task under Actions and then fill up basic details in General Tab

enter image description here

Set the relevant settings in the Trigger Tab

enter image description here

Next in Action tab, create a new action and choose relevant details

enter image description here

Similarly check out other tabs and see if you need to set up anything else

SETTING UP EXCEL MACRO

Paste this code in a module

Option Explicit

Sub Refresh()
    Dim wsCopyFrom As Worksheet
    Dim wsCopyTo As Worksheet
    Dim lastCol As Long
    
    ThisWorkbook.RefreshAll
    
    Set wsCopyFrom = ThisWorkbook.Sheets("Collection")
    Set wsCopyTo = ThisWorkbook.Sheets("Chart")
    
    '~~> Find the next empty column where data will be pasted
    lastCol = wsCopyTo.Cells(1, wsCopyTo.Columns.Count).End(xlToLeft).Column + 1

    wsCopyFrom.Range("D10,J10").Copy
    DoEvents
    
    wsCopyTo.Cells(2, lastCol).PasteSpecial _
    Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    DoEvents
End Sub

And we are done.

WAY 02: HANDLING EVERYTHING FROM EXCEL

Paste this code in a module in Excel (Untested)

Sub Refresh()
    Dim wsCopyFrom As Worksheet
    Dim wsCopyTo As Worksheet
    Dim lastCol As Long
    
    ThisWorkbook.RefreshAll
    
    Set wsCopyFrom = ThisWorkbook.Sheets("Collection")
    Set wsCopyTo = ThisWorkbook.Sheets("Chart")
    
    '~~> Find the next empty column where data will be pasted
    lastCol = wsCopyTo.Cells(1, wsCopyTo.Columns.Count).End(xlToLeft).Column + 1

    wsCopyFrom.Range("D10,J10").Copy
    DoEvents
    
    wsCopyTo.Cells(2, lastCol).PasteSpecial _
    Paste:=xlPasteValues, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    DoEvents
    
    '~~> Do not do anything after 5 PM
    If Now < Date + TimeValue("17:00:00") Then
        Application.OnTime Now + TimeValue("00:15:00"), "Refresh"
    End If
End Sub

At 9 AM just run the procedure once.

INTERESTING READ: How to avoid using Select in Excel VBA

Upvotes: 3

Related Questions