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: