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

 

[Edgar_]

The Access is not supported in our company, unfortunately, howver thanks for trying to help

Don't worry, it might help someone else.