I'm trying to run this VBA macro everyday. The code runs fine manually but won't activate at that time that is stated in the code. I also tried using task scheduler and vbs script, but I couldn't get that to work either so I opted to try to figure this method out first since its less covuluded. In task scheduler, the vbs script worked, but the task didn't automate itself when I ran it, so similar problem. Does anyone know what the issue is? Or have suggestions? Thanks
Private Sub Workbook_Open()
' Set the time to run the macro
Dim runTime As Date
runTime = Date + TimeValue("11:41:00") ' Change the time to the desired run time
' Calculate the time until the next run
Dim timeUntilRun As Date
timeUntilRun = Date + runTime - Now
' Schedule the macro to run at the specified time
Application.OnTime TimeValue(runTime), "UploadDataToFile"
End Sub
Public Sub UploadDataToFile()
On Error GoTo ErrorHandler
'Get today's date
Dim currentDate As Date
currentDate = Date
'Get the last row of data in column B
Dim lastRow As Long
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
'Loop through each row in the data range
Dim i As Long
For i = lastRow To 2 Step -1
If Cells(i, "B").Value < currentDate Then
'If the date in column B is less than today's date, delete the entire row
Rows(i).Delete
End If
Next i
'Set the file name based on the current date
Dim fileName As String
fileName = Format(currentDate, "yyyy-mm-dd") & "TorqueValues.xlsx"
'Set the file path for saving
Dim filePath As String
filePath = "C:\Users\PROD\Documents\" & fileName
'Copy the data to a new workbook
Dim newWorkbook As Workbook
Set newWorkbook = Workbooks.Add
ThisWorkbook.ActiveSheet.Cells.Copy newWorkbook.Worksheets.Add.Cells
'Save the new workbook at the specified file path with the XLSX file format
Application.DisplayAlerts = False
newWorkbook.SaveAs fileName:=filePath, FileFormat:=51
Application.DisplayAlerts = True
newWorkbook.Close SaveChanges:=False
'Code execution will resume here if no errors occur
Exit Sub
ErrorHandler:
'Handle the error
MsgBox "An error occurred: " & Err.Description, vbExclamation
'Optionally, log the error or perform any necessary cleanup
'Code execution will resume here after handling the error
End Sub
Private Sub Workbook_Open()
' Set the time to run the macro
Dim runTime As Date
runTime = Date + TimeValue("11:41:00") ' Change the time to the desired run time
' Calculate the time until the next run
Dim timeUntilRun As Date
timeUntilRun = Date + runTime - Now
' Schedule the macro to run at the specified time
Application.OnTime TimeValue(runTime), "UploadDataToFile"
End Sub
Public Sub UploadDataToFile()
On Error GoTo ErrorHandler
'Get today's date
Dim currentDate As Date
currentDate = Date
'Get the last row of data in column B
Dim lastRow As Long
lastRow = Cells(Rows.Count, "B").End(xlUp).Row
'Loop through each row in the data range
Dim i As Long
For i = lastRow To 2 Step -1
If Cells(i, "B").Value < currentDate Then
'If the date in column B is less than today's date, delete the entire row
Rows(i).Delete
End If
Next i
'Set the file name based on the current date
Dim fileName As String
fileName = Format(currentDate, "yyyy-mm-dd") & "TorqueValues.xlsx"
'Set the file path for saving
Dim filePath As String
filePath = "C:\Users\PROD\Documents\" & fileName
'Copy the data to a new workbook
Dim newWorkbook As Workbook
Set newWorkbook = Workbooks.Add
ThisWorkbook.ActiveSheet.Cells.Copy newWorkbook.Worksheets.Add.Cells
'Save the new workbook at the specified file path with the XLSX file format
Application.DisplayAlerts = False
newWorkbook.SaveAs fileName:=filePath, FileFormat:=51
Application.DisplayAlerts = True
newWorkbook.Close SaveChanges:=False
'Code execution will resume here if no errors occur
Exit Sub
ErrorHandler:
'Handle the error
MsgBox "An error occurred: " & Err.Description, vbExclamation
'Optionally, log the error or perform any necessary cleanup
'Code execution will resume here after handling the error
End Sub
