Code takes longer to run than it should

[Photomofo]

This code works but it takes many times longer than it should. If I insert several breaks into the code and force it to stop several times it actually runs faster than if I don't have any breaks. So for example it takes 44 seconds without breaks and about 6 to 8 seconds with breaks. Has anyone ever heard of a situation like this? Is there a known fix? Is there a way to simulate breaks somehow?

For i = First_Row To 3746 Step -1

If i = First_Row Or InStr(1, System_Files(i, 1), "00:00") > 0 And System_Files(i, 3) <> "X" And System_Files(i, 2) <> "NO" And i < First_Row Then

'Call Library.Get_Attachment
'Call Library.Find_CSV_Files

File_Name = Library.Get_File_Name_1(I)
Workbooks.Open (Path_Hourly & File_Name)
Last_Row_Hourly = Library.Get_Last_Row(Replace(File_Name, ".csv", "", 1), 1)
Data_Hourly = Sheets(Replace(File_Name, ".csv", "", 1)).Range("A1:L100000")
ActiveWorkbook.Close

If i = First_Row Then

File_Name = Left(File_Name, 23) & ".xlsx"

Else

File_Name = Library.Get_File_Name_2(File_Name)

End If

'Create a Daily File if one doesn't already exist

If Dir(Path_Daily & File_Name) = "" Then

Call Library.Create_File(File_Name, Path_Daily)

End If

Workbooks.Open (Path_Daily & File_Name)

Last_Row_Daily = Library.Get_Last_Row("Sheet1", 1) + 1
Data_Daily = Sheets("Sheet1").Range("A1:F100000")

For j = 2 To Last_Row_Hourly

ARG = Data_Hourly(j, 12) 'Text
ARG = Library.Clean_String_6(ARG)
ARG = Library.Clean_String_1(ARG)

If ARG = "" Then

Stop

End If

Data_Daily(Last_Row_Daily, 1) = Library.Clean_String_3(ARG)
Data_Daily(Last_Row_Daily, 2) = Library.Get_State(Data_Hourly(j, 12))
Data_Daily(Last_Row_Daily, 3) = Data_Hourly(j, 1)
Data_Daily(Last_Row_Daily, 4) = Data_Hourly(j, 6)

For k = 7 To 10

If Data_Hourly(j, k) <> " " Then

Data_Daily(Last_Row_Daily, 4) = Data_Daily(Last_Row_Daily, 4) & " - " & Data_Hourly(j, k)

End If

Next k

Data_Daily(Last_Row_Daily, 5) = Data_Hourly(j, 11)
Data_Daily(Last_Row_Daily, 6) = Data_Hourly(j, 2)
Last_Row_Daily = Last_Row_Daily + 1

Next j

Workbooks(File_Name).Activate
Sheets("Sheet1").Select
Sheets("Sheet1").Range("A1:F100000") = Data_Daily

Call Library.Sort_Sheet_1("Sheet1", 2, "B1", 2, 1, 100000, 6)
Call Library.Sort_Sheet_1("Sheet1", 1, "A1", 2, 1, 100000, 6)
Call Library.Sort_Sheet_1("Sheet1", 3, "C1", 2, 1, 100000, 6)

Data_Daily = Sheets("Sheet1").Range("A1:F100000")
Last_Row_Daily = Library.Get_Last_Row("Sheet1", 1)

'Remove Duplicates

For j = 2 To Last_Row_Daily

If Data_Daily(j, 1) = Data_Daily(j + 1, 1) Then
If Data_Daily(j, 2) = Data_Daily(j + 1, 2) Then
If Data_Daily(j, 3) = Data_Daily(j + 1, 3) Then

For k = 1 To 5

Data_Daily(j, k) = ""

Next k

End If
End If
End If

Next j

Workbooks(File_Name).Activate
Sheets("Sheet1").Select
Sheets("Sheet1").Range("A1:F100000") = Data_Daily

Call Library.Sort_Sheet_1("Sheet1", 2, "B1", 2, 1, 100000, 6)
Call Library.Sort_Sheet_1("Sheet1", 1, "A1", 2, 1, 100000, 6)
Call Library.Sort_Sheet_1("Sheet1", 3, "C1", 2, 1, 100000, 6)

'Save and Close Daily File
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=Path_Daily & File_Name, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Application.DisplayAlerts = True
ActiveWorkbook.Close
ThisWorkbook.Activate
Sheets("Files").Cells(i, 3) = "X"

End If

Next i

 

[diddi]

given the sot of disk intensive code you are running i would suspect that your HDD is not keeping up. if it is an old non SSD drive then i would check to see if its performance is compromised by fragmentation or read errors

 

[Photomofo]

Thanks diddi… I restarted my computer just to remove that possibility. A couple of days ago I had this code run relatively super fast on an archive of data (50 days worth) with an average run time of around 6.5 seconds. I don't understand why it's running so much slower now.

Please note... I've tried inserting a few 'application.waits' with a 1 second delay and it quadruples the runtime of the program up to 170 seconds. What the heck is going on here?

BTW... When I say I'm inserting breaks I mean F8 breaks.

This bug totally derails the timing of my program such that it's too slow to do it's job.

 

[Photomofo]

Thanks diddi… I restarted my computer just to remove that possibility. A couple of days ago I had this code run relatively super fast on an archive of data (50 days worth) with an average run time of around 6.5 seconds. I don't understand why it's running so much slower now.

Please note... I've tried inserting a few 'application.waits' with a 1 second delay and it quadruples the runtime of the program up to 170 seconds. What the heck is going on here?

BTW... When I say I'm inserting breaks I mean F8 breaks.

This bug totally derails the timing of my program such that it's too slow to do it's job.

given the sot of disk intensive code you are running i would suspect that your HDD is not keeping up. if it is an old non SSD drive then i would check to see if its performance is compromised by fragmentation or read errors

Hi diddi et al. As always... Thank you for your advice. I'm thinking the problem I'm having is likely due to a function or sub call that refers to sheets... I'm going to investigate this angle.

I should have already realized this but it's a good thing to remember for those reading this. When you work in VBA work in VBA. Calls to sheets take a long time. If I confirm this is the problem I'll update the thread.

 

[diddi]

you might find it interesting to run a small programm called HDSpeed. it does a full platter read test and displays results as it runs. if there is any hint of a bad HDD this will show it up very quickly. restart does not defragment a HDD by it does help with RAM fragmentation. it may very well not be the problem, but it is always useful to have an extra diagnostic tool

 

[Photomofo]

you might find it interesting to run a small programm called HDSpeed. it does a full platter read test and displays results as it runs. if there is any hint of a bad HDD this will show it up very quickly. restart does not defragment a HDD by it does help with RAM fragmentation. it may very well not be the problem, but it is always useful to have an extra diagnostic tool

Thank you for the suggestion. I was able to solve this problem. Rather than opening, saving and closing the Daily File every loop I do a test to see if the file is already open. If the file isn't open you open the new Daily File and then save/close the previous Daily File.