How to execute VBA every 10 minutes?

lojanica · Sunday at 9:08 PM

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.

VBA Code:

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

lojanica · 2024-12-17T19:20:05-0500

I have updated a spreadsheet to make it easier for troubleshooting, i hope that helps

Logit said:

I located a few typos in your macro code. Taken the liberty to copy all of your code and insert the proper commands where they needed to be.
\
Copy / paste the following into a COPY of your workbook (having removed all of the code from the copy PRIOR to pasting the following code).
Let me know how it runs.

Code:

Option Explicit

Sub FilterAll()

Dim mainwb As Workbook
    Dim flowDataSheet As Worksheet
    Dim registerSheet As Worksheet
    Dim lastRow As Long
    Dim table1 As ListObject
    Dim jobNoColumn As Range
    Dim indexColumn As Range
    Dim flowDataRow As Range
    Dim jobNo As Variant
    Dim i As Long

    ' Set references to the main workbook and relevant sheets
    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
   
    registerSheet.Activate
   
'-----Above code is to activate data flow and below is basic filtering----

Set mainwb = ActiveWorkbook

mainwb.Sheets("AMSI-R-102 Job Request Register").Activate
mainwb.Sheets("AMSI-R-102 Job Request Register").Range("A8").Select
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
  ActiveSheet.ShowAllData
End If
 Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Select
 
 Range("B6").Value = Environ("USERNAME")


 
   
   
End Sub



Sub ScheduleclrCol()

Dim TimeToRun

    TimeToRun = Now + TimeValue("00:00:10")     '<----- adjust time to fire here  HH:MM:SS
   
    '##############################################################################################################################
   
    Application.OnTime TimeToRun, "FilterUserTab"   '<----------------------------------------- I changed the macro reference here.
   
    '##############################################################################################################################
   
End Sub


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
   
    '##############################################################################################################################
   
    ScheduleclrCol          '<----------------------------- I changed the macro reference here.
   
    '##############################################################################################################################


End Sub

Sub flowdata()
    Dim mainwb As Workbook
    Dim flowDataSheet As Worksheet
    Dim registerSheet As Worksheet
    Dim lastRow As Long
    Dim table1 As ListObject
    Dim jobNoColumn As Range
    Dim indexColumn As Range
    Dim flowDataRow As Range
    Dim jobNo As Variant
    Dim i As Long

    ' Set references to the main workbook and relevant sheets
    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
   
    registerSheet.Activate

End Sub



' The remaining code is to set a timer for document ideal time,
' Once the document is ideal for the bellow set time, the document will save and close
' Three private subs in "ThisWorkbook" are controlling the below code

'Option Explicit

'Dim CloseTime As Date
'Sub TimeSetting()
    'CloseTime = Now + TimeValue("00:00:20")
    'On Error Resume Next
    'Application.OnTime EarliestTime:=CloseTime, _
      'Procedure:="SavedAndClose", Schedule:=True
'End Sub
'Sub TimeStop()
    'On Error Resume Next
    'Application.OnTime EarliestTime:=CloseTime, _
      'Procedure:="SavedAndClose", Schedule:=False
 'End Sub
'Sub SavedAndClose()
    'Application.DisplayAlerts = False
    'ActiveWorkbook.Close Savechanges:=True
    'Application.DisplayAlerts = True
'End Sub

Sub FilterE5()

    Dim mainwb As Workbook
    Dim targetSheet As Worksheet
   
     ' Set references to the main workbook and relevant sheets
    'Set mainwb = ActiveWorkbook
    'Set registerSheet = mainwb.Sheets("AMSI-R-102 Job Request Register")
 
    If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
        ActiveSheet.ShowAllData
    End If

    Range("A8:NN8").AutoFilter Field:=17, Criteria1:=Range("E5")
    Range("A8:NN8").AutoFilter Field:=19, Criteria1:="In progress"
   
 

End Sub

Thank you for looking to solve this issue it is much appreciated!

when "Option Explicit" is introduced in code I always get an error from the attached photo.
once "Option Explicit' is removed, the code is compiling with no issues and unfortunately, it is the same as before
If I press run it will execute in 10 seconds but will not do it every 10 seconds

It would be much easier I guess if I could send an Excel document

Logit · 2024-12-17T19:34:38-0500

Find the "FilterUserTab" macro ...

Then at the beginning of the macro, insert these lines of code. NOTE: I included the macro name AND a few lines of code already existing in your macro.
ONLY ADD THE NEW LINES OF CODE TO YOUR MACRO, IN THE LOCATION INDICATED BY THE FOLLOWING :

VBA Code:

Sub FilterUserTab()                     '<---- don't include this line of code !!!


'#######################################   ONLY ADD THE LINES BETWEEN THE ############

 Dim mainwb As Workbook
    Dim usernameSheetName As String
    Dim targetSheet As Worksheet
    Dim flowDataSheet As Worksheet
    Dim registerSheet As Worksheet
    Dim table1
    Dim indexColumn
    Dim jobNoColumn
    Dim i As Long
    Dim flowDataRow
    Dim jobNo As Long
    Dim lastRow As Variant
    
'#######################################   ONLY ADD THE LINES BETWEEN THE ############
    
    
    
''<---- don't include the following lines of code !!!
    
' 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")

lojanica · 2024-12-17T20:57:35-0500

Logit said:

Find the "FilterUserTab" macro ...

Then at the beginning of the macro, insert these lines of code. NOTE: I included the macro name AND a few lines of code already existing in your macro.
ONLY ADD THE NEW LINES OF CODE TO YOUR MACRO, IN THE LOCATION INDICATED BY THE FOLLOWING :

VBA Code:

Sub FilterUserTab()                     '<---- don't include this line of code !!!


'#######################################   ONLY ADD THE LINES BETWEEN THE ############

 Dim mainwb As Workbook
    Dim usernameSheetName As String
    Dim targetSheet As Worksheet
    Dim flowDataSheet As Worksheet
    Dim registerSheet As Worksheet
    Dim table1
    Dim indexColumn
    Dim jobNoColumn
    Dim i As Long
    Dim flowDataRow
    Dim jobNo As Long
    Dim lastRow As Variant
   
'#######################################   ONLY ADD THE LINES BETWEEN THE ############
   
   
   
''<---- don't include the following lines of code !!!
   
' 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")

No more errors, however it still only works when i run it not every 10 sec

VBA Code:

Option Explicit
Sub FilterAll()

Dim mainwb As Workbook
    Dim flowDataSheet As Worksheet
    Dim registerSheet As Worksheet
    Dim lastRow As Long
    Dim table1 As ListObject
    Dim jobNoColumn As Range
    Dim indexColumn As Range
    Dim flowDataRow As Range
    Dim jobNo As Variant
    Dim i As Long

    ' Set references to the main workbook and relevant sheets
    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
    
    registerSheet.Activate
    
'-----Above code is to activate data flow and below is basic filtering----

Set mainwb = ActiveWorkbook

mainwb.Sheets("AMSI-R-102 Job Request Register").Activate
mainwb.Sheets("AMSI-R-102 Job Request Register").Range("A8").Select
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
  ActiveSheet.ShowAllData
End If
 Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Select
 
 Range("B6").Value = Environ("USERNAME")

    
End Sub

Sub ScheduleclrCol()

Dim TimeToRun

    TimeToRun = Now + TimeValue("00:00:10")     '<----- adjust time to fire here  HH:MM:SS
    
    '##############################################################################################################################
    
    Application.OnTime TimeToRun, "FilterUserTab"   '<----------------------------------------- I changed the macro reference here.
    
    '##############################################################################################################################
    
End Sub

Sub FilterUserTab()

Dim mainwb As Workbook
    Dim usernameSheetName As String
    Dim targetSheet As Worksheet
    Dim flowDataSheet As Worksheet
    Dim registerSheet As Worksheet
    Dim table1
    Dim indexColumn
    Dim jobNoColumn
    Dim i As Long
    Dim flowDataRow
    Dim jobNo As Long
    Dim lastRow As Variant

' 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
    
    
   '##############################################################################################################################
    
    ScheduleclrCol          '<----------------------------- I changed the macro reference here.
    
    '##############################################################################################################################

End Sub

Sub flowdata()
    Dim mainwb As Workbook
    Dim flowDataSheet As Worksheet
    Dim registerSheet As Worksheet
    Dim lastRow As Long
    Dim table1 As ListObject
    Dim jobNoColumn As Range
    Dim indexColumn As Range
    Dim flowDataRow As Range
    Dim jobNo As Variant
    Dim i As Long

    ' Set references to the main workbook and relevant sheets
    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
    
    registerSheet.Activate

End Sub



' The remaining code is to set a timer for document ideal time,
' Once the document is ideal for the bellow set time, the document will save and close
' Three private subs in "ThisWorkbook" are controlling the below code

'Option Explicit

'Dim CloseTime As Date
'Sub TimeSetting()
    'CloseTime = Now + TimeValue("00:00:20")
    'On Error Resume Next
    'Application.OnTime EarliestTime:=CloseTime, _
      'Procedure:="SavedAndClose", Schedule:=True
'End Sub
'Sub TimeStop()
    'On Error Resume Next
    'Application.OnTime EarliestTime:=CloseTime, _
      'Procedure:="SavedAndClose", Schedule:=False
 'End Sub
'Sub SavedAndClose()
    'Application.DisplayAlerts = False
    'ActiveWorkbook.Close Savechanges:=True
    'Application.DisplayAlerts = True
'End Sub

Sub FilterE5()

    Dim mainwb As Workbook
    Dim targetSheet As Worksheet
    
     ' Set references to the main workbook and relevant sheets
    'Set mainwb = ActiveWorkbook
    'Set registerSheet = mainwb.Sheets("AMSI-R-102 Job Request Register")
   
    If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
        ActiveSheet.ShowAllData
    End If

    Range("A8:NN8").AutoFilter Field:=17, Criteria1:=Range("E5")
    Range("A8:NN8").AutoFilter Field:=19, Criteria1:="In progress"
    
  

End Sub

Logit · 2024-12-17T21:10:49-0500

Paste the following code into a NEW WORKBOOK regular module. Connect a command button to the macro "FilterUserTab "
then run it. See if the timer runs every 10 seconds as designed.

VBA Code:

Sub ScheduleclrCol()

Dim TimeToRun

    TimeToRun = Now + TimeValue("00:00:10")     '<----- adjust time to fire here  HH:MM:SS
    
    '##############################################################################################################################
    
    Application.OnTime TimeToRun, "FilterUserTab"   '<----------------------------------------- I changed the macro reference here.
    
    '##############################################################################################################################
    
End Sub


Sub FilterUserTab()                     '<---- don't include this line of code !!!


Range("A1").Value = Range("A1").Value + 1
    
    '##############################################################################################################################
    
    ScheduleclrCol          '<----------------------------- I changed the macro reference here.
    
    '##############################################################################################################################


End Sub

Logit · 2024-12-17T21:13:05-0500

If it runs as expected, the number in Cell A1 should increment by one, every 10 seconds.

lojanica · 2024-12-17T21:59:56-0500

Logit said:
If it runs as expected, the number in Cell A1 should increment by one, every 10 seconds.

okay I have pasted the following code, please see my extra comments in red
this has been added to the new blank document and workers as expected when i run keep adding numbers, however, if i reopen the document and enable macro it does nothing

VBA Code:

Sub ScheduleclrCol()

Dim TimeToRun

    TimeToRun = Now + TimeValue("00:00:10")     '<----- adjust time to fire here  HH:MM:SS
    
    '##############################################################################################################################
    
    Application.OnTime TimeToRun, "FilterUserTab"   '<----------------------------------------- I changed the macro reference here.
    
    '##############################################################################################################################
    
End Sub


Sub FilterUserTab()                     '<---- don't include this line of code !!![COLOR=rgb(184, 49, 47)]I have kept this in code is that okay [/COLOR]


Range("A1").Value = Range("A1").Value + 1
    
    '##############################################################################################################################
    
    ScheduleclrCol          '<----------------------------- I changed the macro reference here.
    
    '##############################################################################################################################


End Sub

Logit · 2024-12-17T22:01:54-0500

Enabled macros should be on at all times. It is not something you do when you open the workbook. Enable macros then save the workbook. The macros will be enabled automatically
the next time you open the workbook and every time after that.

Just opening the workbook will not make the macro run. You still have to click the button.

Logit · 2024-12-17T22:03:09-0500

<span>I have kept this in code is that okay</span>

Yes that is okay and required. I overlooked having that comment in the code I gave you. Sorry.

Logit · 2024-12-17T22:04:00-0500

Could you tell me where you are located ?

lojanica · 2024-12-17T22:08:02-0500

Logit said:
Could you tell me where you are located ?

I meant Enable content as per the photo attached
I am in Western Australia

How to execute VBA every 10 minutes?

lojanica

New Member

lojanica

New Member

Attachments

Excel Facts

Logit

Well-known Member

lojanica

New Member

Logit

Well-known Member

Logit

Well-known Member

lojanica

New Member

Logit

Well-known Member

Logit

Well-known Member

Logit

Well-known Member

lojanica

New Member

Attachments

Similar threads

Forum statistics

Share this page

How to execute VBA every 10 minutes?

New Member

New Member

Attachments

Excel Facts

Well-known Member

New Member

Well-known Member

Well-known Member

New Member

Well-known Member

Well-known Member

Well-known Member

New Member

Attachments

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock