Code takes longer to run than it should

Photomofo

Board Regular
Joined
Aug 20, 2012
Messages
240
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?
VBA Code:
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
 
Last edited by a moderator:

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).

diddi

Well-known Member
Joined
May 20, 2004
Messages
3,304
Office Version
  1. 2010
Platform
  1. Windows
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

Board Regular
Joined
Aug 20, 2012
Messages
240
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.
 
Last edited:

Photomofo

Board Regular
Joined
Aug 20, 2012
Messages
240
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

Well-known Member
Joined
May 20, 2004
Messages
3,304
Office Version
  1. 2010
Platform
  1. Windows
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

Board Regular
Joined
Aug 20, 2012
Messages
240
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,143
Messages
5,640,384
Members
417,140
Latest member
whiteprose

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top