How to execute VBA every 10 minutes?

[lojanica]

My VBA code is in Module 1 and instead of exciting it manually and on opening of document only I would like to have it execute every 10 min while the document is open. Also, a document is opened by several people at the same time.
Can anyone help with this?

The code below is the one I am looking to execute every 10 min. This is currently being done by opening the document and manually executing it.

Sub FilterUserTab()

 Dim mainwb As Workbook
    Dim usernameSheetName As String
    Dim targetSheet As Worksheet

' Below code is to update new and closed jobs
        
     Set mainwb = ActiveWorkbook
    Set flowDataSheet = mainwb.Sheets("FlowData")
    Set registerSheet = mainwb.Sheets("AMSI-R-102 Job Request Register")
    
    ' Check if the worksheet has autofilter applied
    registerSheet.Activate
    If registerSheet.AutoFilterMode Then
        registerSheet.AutoFilter.ShowAllData
    End If
    
     ' Set references to the ListObject and columns in FlowData sheet
    flowDataSheet.Activate
    Set table1 = flowDataSheet.ListObjects("Table1")
    Set indexColumn = table1.ListColumns("index").DataBodyRange
    Set jobNoColumn = table1.ListColumns("Job No.:").DataBodyRange
    
    ' Loop through each row in the index column of Table1
    
    For i = 1 To indexColumn.Rows.Count
        Set flowDataRow = indexColumn.Cells(i)
        ' Check if the cell in the index column is empty or contains a formula that returns an empty value
        If IsEmpty(flowDataRow.Value) Or flowDataRow.Value = "" Then
            ' Find the corresponding Job No. value in the same row of the table1 in flowdata sheet
            jobNo = jobNoColumn.Cells(flowDataRow.Row - indexColumn.Row + 1).Value
            ' Find the last used row in column B of the register sheet
            lastRow = registerSheet.Cells(registerSheet.Rows.Count, "B").End(xlUp).Row
            ' Copy the Job No. value to the last row + 1 in column B of the register sheet
            'registerSheet.Cells(lastRow + 1, "B").Value = jobNo
            registerSheet.Cells(lastRow + 1, "B").Formula = "=HYPERLINK('FlowData'!P" & i + 1 & ",'FlowData'!B" & i + 1 & ")"
        End If
    Next i
' Update new and closed jobe done next step is Filter user tab
       
    ThisWorkbook.Sheets("AMSI-R-102 Job Request Register").Range("B6").Value = Environ("USERNAME")
    Set mainwb = ActiveWorkbook
    usernameSheetName = mainwb.Sheets("AMSI-R-102 Job Request Register").Range("B6").Value
        
    On Error Resume Next
    Set targetSheet = mainwb.Sheets(usernameSheetName)
    On Error GoTo 0
    
    If Not targetSheet Is Nothing Then
        targetSheet.Activate
    Else
        mainwb.Sheets("AMSI-R-102 Job Request Register").Activate
        Exit Sub
    End If

    If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
        ActiveSheet.ShowAllData
    End If

    Range("A8:N8").AutoFilter Field:=13, Criteria1:=Range("B6")
    Range("A8:N8").AutoFilter Field:=12, Criteria1:="In progress"
    
    lastRow = Cells(Rows.Count, 2).End(xlUp).Row
    Range("A8:N" & lastRow).Sort Key1:=Range("F8:F" & lastRow), Order1:=xlAscending, Header:=xlNo

End Sub

 

[Logit]

Go ahead and click on that to enable the macros. Then if you go to the upper left corner of the Excel workbook, click the Excel button and then click on "Excel Options".
Then go to "Trust Center" ... then "Trust Center Settings". Then click on "Enable all macros". That is the only setting that will work for running macros and not being
pestered with those agitating pop-up notices/warnings.

It is late here (western North Carolina).

I suspect there is something amiss in the code within the macro "FilterUserTab" and it is not throwing an error message to let you know where it is freezing up Excel.
If you place your cursor at the beginning of the macro "FilterUserTab", then one by one, press the F8 key Excel will step through the macro code and simulate running
it. If there is an error it will be found prior to Excel getting to the end of the macro. With that information we can work further on this issue.

 

[Edgar_]

Try this Access file

Just write the name of the procedure, the interval and select a file from the list. Then, just click start and it will run that procedure.

RunExcelProcedureOnTimer.accdb

drive.google.com

In case anyone is wondering, the code looks like this in Access:

Option Compare Database
Option Explicit

Private counter As Long

Private Sub Comando14_Click()
    counter = 0
    
    Dim interval As Long
    interval = Nz(Me.Texto12.Value, 0)
    
    If IsNumeric(Me.Texto12) Then
        Me.TimerInterval = Me.Texto12
    Else
        Me.TimerInterval = 0
    End If
End Sub

Private Sub Comando15_Click()
    Me.TimerInterval = 0
End Sub

Private Sub Comando4_Click()
    PopulateListbox
End Sub

Private Sub Form_Load()
    Me.TimerInterval = 0
    PopulateListbox
End Sub

Private Sub PopulateListbox()
    
    Dim instancesCollection As New Collection
    Set instancesCollection = GetExcelInstances
    
    Dim cleanupDictionary As Object
    Set cleanupDictionary = CreateObject("Scripting.Dictionary")
    
    Lista0.ColumnCount = 2
    Lista0.ColumnWidths = "7 in; 1 in"
    Lista0.RowSource = ""
    
    Dim instance As Object, wb As Object
    For Each instance In instancesCollection
        For Each wb In instance.workbooks
            If Not cleanupDictionary.exists(wb.FullName) Then
                cleanupDictionary.Add wb.FullName, wb.sheets.Count
                Lista0.AddItem wb.FullName & ";" & wb.sheets.Count & " sheets"
            End If
        Next wb
    Next instance
    
End Sub

Private Sub Form_Timer()

    If Not IsNull(Lista0.Value) Then
        counter = counter + 1
    
        Dim procedure As String
        procedure = Nz(Me.Texto10.Value, "")
    
    
        Dim wb As Object
        Set wb = GetObject(Lista0.Value)
        
        Dim fileName As Variant
        fileName = Split(Lista0.Value, "\")
        
        wb.Parent.Run "'" & fileName(UBound(fileName)) & "'!" & procedure
        
        Me.Texto16.Value = procedure & " has run " & counter & " times"
    End If

End Sub

I used Access because its forms have a timer and it's convenient for this.